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CHAPTER  I 


INTRODUCTION 

The  ElectroScience  Laboratory  at  the  Ohio  State  University  has 
constructed  a  compact  radar  range  facility  that  is  capable  of  measuring 
the  complex  backscattered  field  for  a  variety  of  targets  as  a  function 
of  frequency  and  look  angle  [1].  The  compact  range  system  measures  the 
backscattered  signal  as  the  target  is  rotated  in  azimuth  angle  by  a 
computer  controlled  low  cross-section  pedestal  support  (see  Figure  1  and 
Figure  2). 

One  of  the  problems  that  is  encountered  when  the  backscattered 
fields  are  measured,  is  the  presence  of  undesired  signal  components. 

Such  signal  components  include  wall  and  ceiling  reflections  and  some 
leakage  of  transmitter  power  into  the  receiver. 

It  is  essential  to  reduce  such  clutter.  One  way  of  reducing  this 
problem  is  by  background  subtraction  and  calibration  of  the  data.  This 
involves  subtraction  of  background  measurements  from  target  measurements 
and  then  normalizing  the  result  with  respect  to  a  sphere  (see  Appendix  C 
for  details  on  the  calibration  method.) 
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The  program  is  called  ASUPRM,  which  stands  for  Aspect  Scan  User 
Program  for  Radar  Measurements.  It  is  a  software  package  developed  for 
use  on  the  POP-11/23.  This  program  interacts  with  the  user  via  a  set 
of  three  letter  command  words.  The  program  is  capable  of  calibrating 
data  files  containing  as  many  as  3600  data  points.  ASUPRM  contains 
other  options  such  as  reading,  writing,  plotting  and  subtracting  various 
types  of  data  files.  Table  1  is  a  list  of  the  commands  that  are 
available  to  the  user  with  a  brief  description  of  each. 

TABLE  1 

LIST  OF  AVAILABLE  COMMANDS 


1) 

CLB: 

Calibration 

2) 

CLR: 

Clears  CRT 

3) 

EDH: 

Edit  header  lines 

4) 

EXT: 

Exit  from  ASUPRM 

5) 

LST : 

List  of  commands 

6) 

PLT : 

Plot  (on  VT-125) 

7) 

PRN: 

Print  data  (on  CRT) 

8) 

ROF : 

Read  data  file 

9) 

REX: 

Read  exact  file 

10) 

STD: 

Set  Data 

11) 

STF : 

Set  Flags 

12) 

STS: 

Set  plotting  scale 

13) 

SUB: 

Subtraction 

14) 

WDF : 

Write  data  (on  default  disk) 

CHAPTER  II 


ASUPRM  USER'S  GUIDE 


A.  HOW  TO  RUN  THE  PROGRAM 

Listed  below  is  a  step  by  step  procedure  for  running  ASUPRM  on  the 
PDP-11/23  machine. 

1)  Boot  the  sytstem 

2)  Place  ASUPRM  disk  in  DYO  * 

3)  Place  data  disk  in  DY1  * 

4)  Assign  DY1  as  the  default  disk.  This  can  be  done 
by  typing:  ASSIGN  DY1  DK 

5)  Now,  run  the  program.  Type:  RUN  DYO:  ASUPRM 

*Note:  ASUPRM  disk  can  be  placed  in  DY1,  and  the  data  disk  in  DYO 
instead.  Then  step  (4)  would  assign  DYO  as  the  default  disk. 

When  step  (5)  is  completed,  the  user  will  be  prompted  with  the 
following  statement  on  the  CRT  screen. 


ENTER  YOUR  COMMAND: 


Now,  any  of  the  14  commands  can  be  executed  by  typing  the  proper 
three  letter  code  followed  by  <CR>.  If  the  user  types  an  invalid 
command,  the  list  of  commands  with  a  brief  description  of  each  will  be 
typed  on  the  screen,  and  again  the  statement 

ENTER  YOUR  COMMAND: 


B.  THE  COMMANDS 


A  detailed  description  for  executing  the  commands  is  given  below. 

CLB:  This  command  performs  the  calibration  procedure  on  target 
data  with  the  corresponding  sphere  and  background  files. 


The  calibration  equation  is: 


Vct  =  A 


VT  -  VB 

VS  -  vB 


where  Vcj,  Vj,  Vg  and  V$  are  phasor  quantities, 

Vcy:  is  the  calibrated  data 

Vj:  is  the  target  data 

Vg:  is  the  background  data 

Vs:  is  the  sphere  (or  other  calibration  target)  data 

A:  is  the  exact  value  of  the  RCS  of  the  sphere  (or 

other  calibration  target)  in 
(dBsm  or  dBscm),  it  is  a  scalar. 
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There  are  two  ways  to  execute  the  calibration  subroutine.  One  way 
is  to  simply  type,  as  a  command,  "CLB".  The  program  then  will  ask  the 
user  to  enter  the  names  of  the  three  files  involved  in  the  calibration 


and  the  value  of  the  exact  file  in  the  following  order: 

<  >  ENTER  SPHERE  FILE  NAME: 


<  >  ENTER  BACKGROUND  FILE  NAME: 


<  >  ENTER  TARGET  FILE  NAME: 


<  >  ENTER  THE  VALUE  OF  THE  EXACT  FILE: 


When  entering  the  sphere  file  name,  the  calibration  subroutine 
delays  reading  the  file  whereas  target  and  background  files  are  read  in 
(by  calling  subroutine  READDF)  when  their  file  names  are  entered. 

The  other  way  to  perform  calibration  is  to  first  execute  the 
command  "STD"  (see  details  on  "STD").  After  "STD"  is  executed,  type 
command  "CLB",  which  automatically  extracts  the  information  given  when 
"STD"  was  executed  and  then  computes  the  calibrated  data.  When 
calibration  is  done,  the  user  will  be  asked  whether  he  or  she  desires  to 
modify  the  header  information  and  will  be  also  asked  whether  he  or  she 
wants  to  write  (on  the  default  disk)  the  calibrated  data. 


The  reason  for  developing  two  procedures  for  executing  the 
calibration  subroutine  is  for  the  user's  convenience.  Occasionally,  it 
is  desired  to  calibrate  many  different  target  files  with  respect  to  the 
same  sphere,  background  and  exact  files,  hence  it  becomes  redundant  to 
enter  the  same  information  every  time  calibration  is  performed. 


CLR:  This  command  clears  the  CRT  screen.  It  is  often  used  after 
plotting  a  data  file. 


EDH:  Use  of  this  command  permits  the  user  to  modify  an  existing 
header.  When  "EDH"  is  executed,  all  three  lines  are  printed  on  the 
screen  and  the  user  is  asked  which  line  to  is  be  edited.  Consider  the 
following  example. 


ENTER  YOUR  COMMAND:  EDH 


Line  I 


Line  2 


Line  3 


I  AM  A  DATA  FILE  CALLED  TARGET 
THIS  IS  LINE  NUMBER  TWO 


THIS  IS  LINE  NUMBER  THREE 


Line  ?  1 


Line  1:  I  AM  A  DATA  FILE  CALLED  TARGET 


Line  1:  I  AM  NOT  A  DATA  FILE 


Line  ?  <CR> 

ENTER  YOUR  COMMAND: 


Use  <CR>  to  exit  from  this  subroutine  at  request  of  line  number. 

Use  to  delete  characters  and  "»M  to  insert  with  "#"  at  the  end  of 
inserted  word. 

EXT :  This  command  exits  from  ASUPRM  gracefully. 

LST :  This  command  supplies  the  user  with  a  list  of  all  the 
available  commands  with  a  brief  description  of  each.  There  are  14 
commands.  The  command  list  will  also  be  printed  on  the  CRT  any  time  an 
illegal  command  is  used  by  the  user. 

PLT :  This  command  allows  the  user  to  plot  data  from  the  virtual 
memory  array  data  (files  can  be  target,  background  or  sphere  files.) 

When  executing  this  command,  the  user  is  asked  to  enter  the  type  of  file 
(a  set  of  two  letter  codes,  TF,  BF,  SF  for  target  background  and  sphere 
files  respectively). 

When  the  file  is  specified,  the  computer  types  the  name  of  the  file 
and  asks  the  user  If  he/she  desires  to  plot  that  file  or  whether  to  plot 
another.  When  the  desfred  file  name  is  agreed  and  minimum  values  of 
amplitude  and  phase  are  computed  and  typed  out  on  the  screen  as  follows 


MAXIMUM  AMPLITUDE  = 


MINIMUM  AMPLITUDE  = 


MAXIMUM  PHASE  = 


MINIMUM  PHASE  = 


The  computer  will  then  ask  the  user  the  following: 


DO  YOU  DESIRE  TO  SET  YOUR  OWN  SCALE? 

IF  YES,  TYPE  "Y".  IF  NOT  PUSH  RETURN. 


If  the  user  decides  to  set  a  particular  scale,  then  the  subroutine 
which  sets  the  scale  will  be  called.  If,  however  the  user  decides  not 
tc  choose  a  particular  scale,  then  an  automatic  scale  adjustment  will 
occur.  This  scale  causes  the  maximum  value  to  be  rounded  up  to  the  next 
factor  of  ten,  and  the  minimum  value  to  be  rounded  down  to  the  previous 
factor  of  ten.  An  example  is  illustrated  in  Figure  4. 

If  the  scale  was  previously  set  by  executing  "STS",  then  it  will 
display  the  scale  values,  type  out  the  maximum  and  minimum  values  of  the 
data  to  be  plotted  and  then  ask  the  user  whether  he/she  still  desires 
the  existing  scales.  If  the  user  decides  to  change  them,  he/she  may  do 
so,  and  the  subroutines  which  set  the  scale  will  be  called  again. 
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Figure  4.  An  example  of  an  amplitude  plot  for  a  data  file.  Maximum 
amplitude  is  +3dB  and  minimum  amplitude  is  -30dB. 


The  user  will  be  required  to  specify  the  range  of  aspect  angle  for 
plotting,  enabling  the  user  to  stretch  the  horizontal  scale  as  desired. 
The  plot  will  consist  of  two  graphs,  one  for  amplitude  and  the  other  for 
phase,  both  as  a  function  of  aspect  angle.  During  the  plotting 
procedure,  the  subroutine  can  be  interrupted  by  pushing  the  carriage 
return  (<CR>).  If  the  user  does  so,  the  plotting  procedure  halts.  If 
the  letter  "Q"  is  typed,  the  plotting  subroutine  is  terminated  and  the 
user  goes  back  to  command  mode.  (At  this  stage  the  screen  may  be 
cleared  by  typing  "CLR".)  If,  however  instead  of  typing  "0",  the  user 
types  any  other  letter  or  <CR>,  the  plotting  resumes  from  where  it  was 
interrupted. 

i 
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PRN:  This  command  permits  the  user  to  get  a  printout  on  the  CRT 
screen  of  a  specified  portion  of  a  data  file.  To  be  able  to  execute 
"PRN",  you  must  have  the  desired  data  in  virtual  memory.  This  may  be 
accomplished  by  reading  in  the  data  file  using  "RDF"  command. 

A  range  of  aspect  angles  must  be  specified: 

ai  <  a  <  a2 

When  "PRN"  is  executed,  the  computer  asks  the  user  for  the  value  of 
a,  and  c»2  in  the  following  order: 

ENTER  VALUE  OF  ALPHA1: 

when  entered 

ENTER  VALUE  OF  ALPHA2: 

When  entered,  a  list  of  aspect  angles  and  the  corresponding  data 
point  -  amplitude  and  phase  -  is  printed  on  the  screen. 

RDF:  This  command  allows  a  data  file  to  be  read  into  the  virtual 
memory.  A  data  file  can  be  a  target,  background  or  a  sphere  file, 
depending  on  the  specification. 


Upon  executing  "RDF  ,  the  user  will  be  prompted  with  the  following 


TARGET 


BACKGROUND  FILE 
SPHERE  FILE 


ENTER  TYPE  OF  FILE: 


The  user  should  use  the  above  two  letter  codes  to  specify  the  data 
When  the  file  is  specified,  the  following  statement  appears: 


TARGET 

or 

<  >  ENTER  BACKGROUND  FILE  NAME: 


REX:  This  command  allows  the  exact  calibration  value  to  be  read 
in.  This  value  is  a  single  number,  usually  in  "dBsm"  (decibels  above  a 
square  meter).  This  number  must  be  supplied  by  the  user  in  units  of 
"dBsm".  (Decibels  above  a  square  centimeter  "dBscm"  is  also 
acceptable.) 


STD:  When  this  command  is  executed,  data  file  names  of  the  target, 
sphere  and  background  with  the  value  of  the  exact  file  are  stored  in  a 
buffer.  When  "CLB"  is  entered  as  a  command  by  the  user,  the  calibration 
subroutine  automatically  extracts  the  required  information  from  the 
buffer.  (Makes  calibration  more  enjoyable.) 


Here  is  how  it  works. 


When  STD  is  typed,  the  computer  types  the  following: 


TARGET 

(1) 

BACKGROUND 

(2) 

SPHERE 

(3) 

EXACT  VALUE 

(4) 

LISTING 

(5) 

OPTION 

(?) 

The  computer  now  is  waiting  for  an  option  to  be  selected  between 
(1)  and  (5).  If  0  or  <CR>  is  typed,  the  system  goes  back  to  command 
mode.  If  the  option  number  is  more  than  5,  the  program  asks  for  the 
option  again. 

As  an  example,  say  the  user  selects  option  1,  the  computer  will 
request  the  following: 


ENTER  TARGET  FILE  NAME: 


Similarly,  for  options  2,  3  and  4.  If  option  5  is  selected,  the 
list  of  file  names  is  typed  on  the  screen,  i.e.: 


TARGET 


:  A3242C 


BACKGROUND: 

A3242A 

SPHERE 

A3242B 

EXACT  FILE: 

-17.4 

SIT:  This  command  permits  the  user  to  reset  the  current  status  of 
the  flags. 

What  are  the  flags? 

ASUPRM  uses  six  integer  variables  to  check  for  specific 
information.  Basically  the  information  indicates  whether  a  particular 
subroutine  was  executed  or  not.  If  a  subroutine  was  executed,  the  value 
of  the  flag  is  1,  otherwise  its  value  is  0.  The  flags  are  typed  as  a 
six  digit  integer  number. 

Flags  =  Ii  I2  I3  I4  I5  Ig 

Each  value  1^,  k  =  1,  2,  .  .  .,  6,  determines  the  state  of 
subroutine  Sk.  If  I|<  =  1  then  S|<  was  executed  if  I|<  =  0,  then  S|<  was 
not  executed. 

(a)  Flag  #(1),  i.e.  I,  determines  whether  a  target  file  has  been 
defined. 

(b)  Flag  #(2),  i.e.  l2,  determines  whether  a  background  file  has 


been  defined. 


(c)  Flag  #(3),  i.e.  1 3 ,  determines  whether  a  sphere  file  has  been 
defined. 

(d)  Flag  #(4),  i.e.  I4,  determines  whether  a  value  for  the  exact 
fi  le  has  been  defined. 

(e)  Flag  #(5),  i.e.,  1 5 ,  determines  whether  a  plotting  scale  has 
been  defined. 

(f)  Flag  #(6),  i.e.  lg,  determines  whether  file  names  exist  in  the 
buffer  used  by  the  calibration  subroutine. 


ITS:  This  command  allows  the  user  to  set  the  plotting  scale.  When 
is  used  the  following  values  are  defined: 


MAXIMUM  AMPLITUDE 


MINIMUM  AMPLITUDE 


MAXIMUM  PHASE  ANGLE 


MINIMUM  PHASE  ANGLE 


In  case  the  user  makes  a  typing  error  the  routine  asks  if  any 
typing  errors  were  made  so  that  the  user  can  enter  the  values  again. 

Unce  the  scale  is  set,  it  is  valid  for  subsequent  plots,  unless 
specified  in  the  plotting  subroutine. 


CHAPTER  III 


PROGRAMMER’S  GUIDE 

Circumstances  might  arise  where  a  particular  user  needs  to  expand 
the  total  number  of  data  points,  i.e.,  decrease  the  increment  in  aspect 
angle.  From  appendix  (A),  the  total  number  of  virtual  memory  is  65,536 
bytes. 

Thus,  the  maximum  number  of  data  points  that  can  be  stored  in  one 
data  file  is 

65,536  -  360 

Np  =  g  =  8,147  points 

each  point  consisting  of  an  amplitude  and  phase. 

Therefore,  the  minimum  increment  in  aspect  angle  is  Ahmin, 


360 

4%ii n  =  8,147-1  5  0.0442  (degrees) 

If  we  choose  A3  =  0.05°,  this  corresponds  to  an  array  of: 

360 

2. ( 0.05  +l)  =  7201  x  2  elements 

Therefore,  the  virtual  arrays  that  were  used  UT(3604,2)  and  UB 
(3604,2)  will  have  to  be  replaced  by  another  virtual  array; 

ARRAY  (7201,2). 


Doing  so,  the  algorithm  for  the  calibration  subroutine  should  be 
modified.  Figure  5  shows  the  modification  necessary  in  the  algorithm 


CONCLUSIONS 


In  summary,  ASPURM  gives  a  wide  variety  of  options  for  the 
manipulation  of  aspect  angle  data  files.  Such  options  include 
calibration,  subtaction,  plotting,  reading  and  writing  various  types  of 
data  files.  The  program  was  also  designed  to  permit  modification  and/or 
addition  of  new  command  options  (see  discussion  in  programmer's  guide). 
An  effort  was  made  to  prevent  program  failure  during  operation  (e.g., 
upon  the  use  of  illegal  commands  or  parameters  by  the  user). 


APPENDIX  A 


DATA  FORMAT 


The  standard  form  of  a  data  file  stored  on  a  floppy  disk  is  given 


in  Tables  A-l  and  A-2  [2]. 


TABLE  A-l 

DATA  ARRANGEMENT  OF  A  STANDARD  FILE  [2] 


LINE  1  (60  characters) 

J 

FILE  HEADER 

LINE  2  (60  characters) 

i 

LINE  3  (60  characters 

DATA  POINT  1 

Amplitude  In  dB,  phase  In  degrees 

DATA  POINT  2 

Amplitude  In  dB,  phase  In  degrees 

• 

V 

• 

• 

U 

DATA  POINT  801 

• 

• 

,  i 

u 

* 
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< 

ji 

i 


APPENDIX  B 


STORAGE  CAPACITY  REQUIREMENT 


Why  3600  data  points? 

The  PDP  -  11/23  virtual  memory  capacity  is  64k  bytes,  call  it 
Cv.max* 

cv,max  =  64  (210)  =  65,536  bytes 

Let  the  total  number  of  data  points  (a  data  point  contains  both 
amplitude  and  phase)  possible  to  manipulate  be  Mv. 

In  a  standard  data  file,  each  data  point  takes  up  eight  bytes  - 
four  bytes  for  amplitude  and  four  bytes  for  phase.  A  data  file  also 
contains  header  Information,  they  take  up  360  bytes  of  memory. 

If  the  total  number  of  bytes/data  file  is  Nj: 

NT  =  8  Mv  +  360 

The  calibration  algorithm  that  ASUPRM  uses  requires  reading  in  two 
data  files  and  opening  the  header  for  one. 

=>  Cv,max  *  2(8MV  +  360)  +  360. 

But 


cv,max  =  65,536  bytes 


=>  65,536  =  16MV  +  1080 


65,536  -  1080 
=>  Mv  =  - 15 - 

Mv  •  4028 

Let  the  increment  in  aspect  angle  be  A  9a  in  degrees. 
360 

*>  +  1  <  Mv 

has  to  be  satisfied. 

360 

■>  a9A  >  Mv'"-  T 

and  using  the  result  that  Mv  «  4028, 

360 

A 9a  >  4028-1  “  0.0894 

=>  A9a  >  0.0894 

Thus,  if  we  choose  a  nice  number  for  A«a,  A9a  =  0.1 
=>  Number  of  data  points  becomes 
360 

TJ7T  +  1  =  3601 

and  AeA  *  0.0894  iS  still  satisfied. 
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(**)  In  equation  (C-3),  the  arc  tangent  function  is  a  four-quadrant 
arc  tangent  function. 


APPENDIX  D 
LINKER  SEQUENCE 

LINKER  COMMAND  SEQUENCE  LIST 
ASUPRM 

WRITDF 

SUBWRI 

EOTHDF 

SUBHDR 

CALBDF 

SUBTDF 

PRNTDF 

PNTOUT 

SETFLG 

SETDTA 

SETSCL 

MINMAX 

LSTCMD 

READDF 

SUBREA 

EXIT 

READNM 

PLOTDF 

NUMBER 

FRAME 

CLRCRT 

PLACEP 

DRLIB 


APPENDIX  E 


ORIGINAL  SUBROUTINES  FOR  ASUPRM 

The  list  below,  is  of  the  Fortran  programs  (subroutines)  that  were 
developed  specifically  fcr  ASUPRM  (not  including  the  subroutines  written 
before  ASUPRM  was  developed).  These  subroutines  are: 


1) 

READDF 

2) 

SUBREA 

(ARRAY, k) 

3) 

WRITOF 

4) 

SUBWRI 

(ARRAY, k) 

5) 

READNM 

6) 

PRNTDF 

7) 

PNTOUT 

8) 

LSTCMD 

9) 

EXIT 

10) 

CLEAR 

ID 

EDTHDF 

12) 

PLOTDF 

13) 

MINMAX 

14) 

SETSCL 

151 

SETDTA 

16) 

SETFLG 

17) 

CALBDF 

18) 

SUBTDF 

19) 

ASUPRM 

Note  that  SUBREA  (ARRAY, k)  and  SUBWRI (ARRAY, k )  are  modifications  of 
previously  written  subroutines  called  SUBREA  (ARRAY)  and  SUBWRI 
(ARRAY)  respectively.  The  subscript  k,  takes  on  values  of  1,  2,  3,  4 
and  5  for  target,  background,  sphere,  Y  or  X  files  respectively. 


I 


IP 

c> 


APPENDIX  F 


ASUPRM  PROGRAM 

I 

i 


i 


s 
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q*********************************************************************** 

c********************  THIS  is  the  main  program  ********************* 


£*********************************************************************** 

c 

VIRTUAL  UT( 3604, 2), 08(3604,2) 

C 

CALL  CLRCRT 
TYPE  77 

77  FORMAT ( ,/ 

+  10X  1 

+  ]lOX/<<  ASPECT  SCAN  USER  PROGRAM  FOR  RADAR  MEASUREMENTS  »',/ 


+ 

,10X,' 

kkk 

kkkk 

k 

k 

kkkk 

kkkk 

** 

** 

,/ 

+ 

,10X,‘ 

k 

k 

k 

k 

k 

k  k 

k 

* 

* 

*  *  * 

,/ 

+ 

,10X,' 

kkkkk 

*** 

k 

k 

kkkk 

**** 

★ 

*  * 

,/ 

+ 

,  10X,  • 

k 

k 

★ 

k 

k 

k 

* 

* 

★ 

* 

J 

+ 

.10X,1 

11=0 

k 

k 

kkkk 

kkkkk 

k 

★ 

* 

* 

* 

Jill) 

C  THE  TWO  LINES  8EL0W  CAUSE  THE  SYSTEM  TO  BEEP  ! 
C 

369  FORMAT (10A1) 

TYPE  369,'  ',1799 


C 

20 

80 

73 


35 


**' 


•,$) 


TYPE  80 

FORMAT (//,'  **>  ENTER  YOUR  COMMAND 

ACCEPT  73.CMD 
FORMAT (A3) 

IF (CMD.EQ. 'STF 1 )GOTO  40 
IF(CMD.EQ. 1 STU 1 )GOTO  42 
IF (CMD.EQ. ' SUB  1 )GOTO  48 
IF(CMO.Etj.  ‘EDH*  )GOTO  50 
IF (CMD.EO. ‘ PRN 1 )GOTU  100 
IF (CMD.EQ. ' EDH 1 )GOTO  111 
IF (CMD.EQ.1 REX' )GOTO  222 
IF(CMD.EQ.'RDF' )GOTO  333 
IF (CMD.EQ. 'WDF 1 )GOTO  666 
IF (CMD.EQ. 'CLB ' )GOTO  777 
IF (CMD.EQ. 1 PLT 1 )GOTO  888 
IF(CMD.EQ.'LST')GOTO  999 
IF (CMD.EQ. 'EXT 1 )GOTO  1000 
IF (CMD.EQ. ' CLR ' )GOTO  1100 
IF (CMD.EQ. 1  STS 1 )GOTO  1200 
TYPE  35 

FORMAT (/ , 1  •  ILLEGAL  USE  OF  COMMAND, TRY  AGAIN  .',) 
11=11+1 

IF ( 1 1  ,EQ.4)G0T0  1000 
GOTO  999 
CALL  SETFLG 
GOTO  21 


40 


T.  . 


m 


SETDTA 

21 

SUBTDF(UT,U6) 

21 

EDTHDF 

21 

PRNTDF(UT.UB) 

21 

SUBHDR 

21 

READNM 

21 

REABDF(UT,UB) 

21 

WRITDF(UT,UB) 

21 

CALBDF ( UT, U8 ) 
21 

PLOTUF ( UT ,UB ) 
21 

CLRCRT 

21 

SETSCL 

21 

LSTCMD 

20 

EXIT 


m 


i 


C***************  THIS  SUBROUTINES  LISTS  THE  COMMANDS  **************** 

Q  ★★★★★★*★***★★★*★*★*★★★★•*★★★★★★★★★**•★★*’★*■*•★★★★★*'****★*★**★*★*★******★**★ 

C 

SUBROUTINE  LSTCMD 
TYPE  10 

10  FORMAT ( 1  <**  COMMANDS  AVAILABLE  FOR  USER  **>  ',/) 

TYPE  11 

FORMAT ( 1  *********************************************** 1 ^ ^ 

TYPE  12 

12  FORMAT(*  1)  LST  :  Lists  the  commands  available  for  user  .',/ 

+  2)  ROF  :  Reads  a  data  file  from  Default  Disk  .*,/ 

+  3)  REX  :  Reads  the  multiplying  factor 

+  4)  EOH  :  Edits  header  information  of  a  data  file 

+  5)  PLT  :  Plots  a  data  file  on  the  “VT-100" 

+  , '  6)  WDF  :  Writes  a  data  file  on  the  Default  Disk 

+  7)  PRN  :  Writes  out  a  specified  portion  of  a  data1,/ 

+  ,'  file  on  the  "CRT"  screen 

+  , 1  8)  CLB  :  Calibrates  data  file 

+  9)  SUB  :  Subtracts  a  data  file  from  another 

+  10)  CLR  :  Clears  the  "CRT"  screen 

+  11)  STS  :  Allows  the  user  to  set  his  own  plotting  scale 

+  , 1  12)  STL)  :  Allows  the  user  to  set  his  data  files  for  ',/ 

+  calibration  at  once 

+  13)  STF  :  Allows  the  user  to  control  the  main  program  ’,/ 

+  ,'  by  setting  values  for  the  flags  as  desired 

+  , '  14)  EXT  :  Exits  from  the  program  completely 

+  ^  1 ★★*★★★★*★★★**★*★*★*★★**★*★★★★★★★★★★**★***★****★★★★ *  ^  j 

RETURN 

END 


A 


c*********************************************************************** 


c***************  XH I S  SUBROUTINE  READS  A  DATA  FILE  ******************* 

Q* **************************  ******************************************** 

c 

SUBROUTINE  READOF(UT.UB) 

VIRTUAL  UT ( 3604 , 2 ) , UB ( 3604 , 2 ) 

INTEGER  FT 
COMMON/ KRSB/ IJK 
COMMON/FKIND/FT 

COMMON/FLAGS/MT ,MB .MS .MN.MST ,MSD 

C 

C  IJK  :  IS  A  VARIABLE  WHICH  TAKES  ON  A  VALUE  OF  "1"  IN  CASE  OF  ERROR 

C  IN  READING  THE  DATA  FILE  .AND  A  VALUE  OF  "0"  OTHERWISE  . 

C 

MSD=0 

C 

11  TYPE  12 

12  FORMAT (/ , '  TF  :  TARGET  FILE  ',/ 

+  ,'  BF  :  BACKGROUND  FILE  ',/ 

+  ,'  SF  :  SPHERE  FILE  ',//,$) 

TYPE  13 

13  FORMAT (  / , 1  SPECIFY  FILE  TYPE  :  ',$) 

ACCEPT  14, FT 

14  FORMAT (A2) 

IF (FT.EQ. 1 TF 1 )GOTU  45 
IF (FT .EQ. 1 BF ‘ )GOTO  50 
IF(FT.EQ.'SF')G0T0  51 
TYPE  77 

77  FORMAT (/ , 1  ILLEGAL  FILE  SPECIFICATION  .TRY  AGAIN 

GOTO  11 
45  MT=1 

CALL  SUBREA(UT.l) 

IF(IJK.EQ.1)G0T0  25 
RETURN 
25  IJK=0 

RETURN 

50  MB=1  !  SETTING  FLAGS  . 

MS=0 

CALL  SUBREA(U8,2) 

IF ( I JK .EQ. 1 )GOTO  25 
RETURN 

51  MS=1  !  SETTING  FLAGS  . 

MB=0 

CALL  SUBREA(UB,3) 

IF(  IJK.EQ.1)G0TU  25 
RETURN 


SUBROUTINE  SUBREA(ARRAY.K) 


C 

Q 

C  THIS  ROUTINE  READS  AN  OLD  DATA  FILE 

C  FROM  THE  USER  DISC.  STATUS  WORDS  FOR 

C  PLOTTING  AND  SUBTRACTION  ARE  RESET. 

C  CALLED  FROM:SYSTEM 

C  CALLS: NONE 

Q  *★*★*★*★**★****★★**★**★★★**★★★★★★★★★*★ 

C 

C  VARIABLES 

C 

BYTE  LINE  1(60) .LINE 2(6U) ,PARAM(60) 

BYTE  FNMT ( 31 ) ,FNMB( 31 ) 

COMMON  /KRSB/IJK 
COMMON  /FLG/  FLAG 
COMMON  /FILE/ ITSl.KT, ISTYP, I FLG 
COMMON  /LISFRQ/  LOFQ, IUPFq, INCRE 
COMMON  /MHDR/  LINE1 .LINE2.PARAM.HDR 
COMMON  /MWRI/  FNMT.FNMB 
COMMON  /SFINO/  STRG.KSTRG.KCHR 
C 

COMMON/ FLAGS/MT, MB, MS, MN.MST.MSO 
C 

DOUBLE  PRECISION  STRG(25) 

INTEGER  KCHR(25) 

LOGICAL  HDR 
VIRTUAL  ARRAY ( 3604,2) 

C 

C  FORMATS 

C 


002 

FORMAT 

(31A1 ) 

('  * ,60A1 ) 

003 

FORMAT 

004 

FORMAT 

(14) 

005 

FORMAT 

(15) 

010 

FORMAT 

C  <><>  ENTER  TARGET  FILE  NAME  :  ',$) 

('  <><>  ENTER  BACKGROUND  FILE  NAME  :  ', 

Oil 

FORMAT 

012 

FORMAT 

(‘  <><>  ENTER  SPHERE  FILE  NAME  :  ',$) 

013 

FORMAT 

('  <><>  ENTER  NAME  OF  FILE  "X"  :  ',$) 

014 

FORMAT 

('  <><>  ENTER  NAME  OF  FILE  "Y"  :  ',$) 

050 

FORMAT 

('  Open  Error--File  Does  Not  Exist.') 

051 

FORMAT 

('  Decode  Error--Line  Counter  "KT".') 

052 

FORMAT 

('  —  Read  Aborted  — ') 

88 

FORMAT 

(12) 

C 


C 

IF(K.EQ.4)G0T0  478 
IF(K.EQ.5)G0TU  479 
IF(MSD.EQ.1)G0T0  450 
GOTO  110 


GOT 0  2220 
TYPE  014 
GOTO  1110 

IF (MSD.EQ.l )GOTO  450 
GOTO  110 

IF (K-2) 1109,2219, 335 

IF (K-2) 111 ,222,333 

TYPE  010 

ACCEPT  002.FNMT 

IF  (FNMT (2) .EQ.32)  TYPE  052 

IF  (FNMT(2). EQ.32)  GOTO  351 

GOTO  444 

IJK=1 

RETURN 

TYPE  Oil 

ACCEPT  002,FNMB 

IF  (FNMB(2). EQ.32)  TYPE  052 

IF  (FNMB(2). EQ.32)  GOTO  351 

GOTO  555 

TYPE  012 

ACCEPT  002.FNMB 

IF(FNMB(2). EQ.32)  TYPE  052 

IF(FNMB(2). EQ.32)  GOTO  351 

GOTO  555 

OPEN  FILE 

OPEN  ( UN  I T = 1 3 , NAME  =F  NMT , T  Y  P  E  = ' OLD ’ , F  ORM= 1 UNF  ORMATTED 
&  READONLY, ERR=1000) 

GOTO  567 

OPEN  (UNIT=13,NAME=FNMB ,TYPE='OLD ' ,FORM= ' UNFORMATTED 
&  READONLY, ERR=1000) 

READ  (13)  LINE1 
READ  (13)  LINE2 
READ  (13)  PARAM 
TYPE  003.LINE1 
TYPE  003, LINE 2 
TYPE  003, PARAM 

HDR=.TRUE. 

DECODE  HEADER 

IF  (PARAM(8) ,EQ. 'F * )  GO  TO  995 
DECODE  (4,004,PARAM(4) ,ERR=1001 )  KT 
DECODE  (5,005,PARAM( 12) , ERR =1001)  LOFQ 
DECODE  (5,005,PARAM(21) ,ERR=1001)  INCRE 
DECOOE  (2, 88, PARAM (31) , ERR =1008)  ISTYP 
GO  TO  388 


995  DECODE  (4,2004,PARAM(4),ERR=1001)  KT 

2004  FORMAT  (13) 

DECODE  (5,005,PARAM( 11 ) , ERR =1001 )  LOFQ 
DECODE  (5,005,PARAM(20) , ERR =1001 )  INCRE 
ISTYP=0 
C 
C 

C  SET  BAKAVE  FLAGS  AND  TYPES  [SCN  TYPE] 

C 

388  IFLG=0 

IF  (MOD( ISTYP.10) .NE.3)  GO  TO  389 
IFLG=2 

389  CNE=INCRE/ 100. 

IUPFQ=IF IX(L0FQ+(KT-1 )*CNE ) 

C 

FMIN=LOFQ 

FMAX=IUPFQ 

C 

00  200  K1=1,KT 

READ  (13)  ARRAY (Kl,l), ARRAY (Kl, 2) 

200  CONTINUE 

C 

C  GET  AVE  VALUES  IF  PRESENT  [JUNK  OTHERWISE] 

IF  (PARAM(8).EQ.'F')  GO  TO  1004 
C 

READ  (13)  ARRAY(3603,1),ARRAY(3603,2) 

READ  (13)  ARRAY (3604,1), ARRAY (3604, 2) 

C 

1004  CLOSE  (UNIT=13,DISP='SAVE 1 ) 

RETURN 

1000  TYPE  050 
I  JK=1 
RETURN 

1001  TYPE  051 
I  JK=1 
RETURN 

1008  TYPE  VOld  File  Type1 

ISTYP=-1 
GO  TO  388 


£****************************★****************************************** 


c*********  THIS  SUBROUTINE  READS  THE  EXACT  FILE  VALUE  ' AE '  .  ********* 

Q  **************  ********************************************************* 


C 

SUBROUTINE  REAONM 
COMMON/FLAGS/MT ,MB ,MS ,MN,MST 
COMMON/MULTF/AE 
MN=1 

21  TYPE  23 

23  FORMAT (// , 1  ENTER  EXACT  FILE  VALUE  =  ',$) 

22  F0RMAT(F8.2) 

READ( 5,22,ERR=28)AE 
RETURN 

28  TYPE  19 

19  FORMAT (/ 1  (*)  ILLEGAL  FORMAT  SPECIFICATION  (*)') 

GOTO  21 
RETURN 
ENO 


C*****************  JHIS  SUBROUTINE  WRITES  A  DATA  FILE  **************** 

Q *************************************************************** ******** 


SUBROUTINE  WRITDF(UT.UB) 

VIRTUAL  UT ( 3604 , 2 ) , UB ( 3604 , 2 ) 

INTEGER  FK 

C 

COMMON/FLAGS/MT ,MB ,MS,MN ,MST 
COMMON/DDI/FT 

C 

66  TYPE  11 

11  FORMAT (//, '  TARGET  FILE  :  TF  ',/ 

+  BACKGROUND  FILE  :  8F  ',/ 

+  SPHERE  FILE  :  SF  ',/ 

+  CALIBRATED  FILE  :  CF  ',//,$) 

TYPE  12 

12  FORMAT (/ , 1  SPECIFY  FILE  TYPE  :  ',$) 

ACCEPT  IS, FT 

15  FORMAT (A2) 

IF(FT.EQ. 1 TF 1 )GOTO  22 
IF (FT.EQ. 'BF 1 )GOTO  33 
IF(FT.EQ. ‘SF 1 )GOTO  34 
IF (FT.EQ. 1 CF 1 )GOTO  22 
TYPE  88 

88  FORMAT(/,'  (*)  ILLEGAL  FILE  SPECIFICATION  ,TRY  AGAIN 

GOTO  66 

22  CALL  SUBWRI (UT, 1) 

RETURN 

33  CALL  SUBWRI (UB, 2) 

RETURN 

CALL  SUBWRI (UB, 3) 

RETURN 
END 
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SUBROUTINE  SUBWRI (ARRAY, L) 

C 

r  ********************************************** 

C  THIS  WRITES  A  FILE 

C 

Q  ********************************************** 

C 

C  VARIABLES 

C 

BYTE  LINE1(6U),L1NE2(60),PARAM(60) 

BYTE  FNMT (31) ,FNMB( 31) ,FNMS(31) 

COMMON  /MHOR/  L I NE 1 , L I NE 2 , PARAM , HDR 
COMMON  /MWR 1/  FNMT ,FNMB ,FNMS 
COMMON  /FILE/ITS.KT, ISTYP, IFLG 
LOGICAL  HDR.ANS 
REAL  ARRAY 

VIRTUAL  ARRAY ( 3604,2) 

C 

ANS=.TRUE .  !SET  FOR  LAST  ABORT 

C 

C  FORMATS 

C 

001  FORMAT  ('  ') 

002  FORMAT  (31A1) 

004  FORMAT  ('  \60A1) 

009  FORMAT  ('  <>  ENTER  TARGET  FILE  NAME  :  ',$) 

008  FORMAT  (’  <>  ENTER  BACKGROUND  FILE  NAME  :  ',$) 

007  FORMAT  (*  <>  ENTER  SPHERE  FILE  NAME  :  ',$) 

050  FORMAT  (‘  Open  Error  —  Data  In  FTN13.DAT' ) 

051  FORMAT  (‘  —  No  Data  Available  — ') 

052  FORMAT  ('  —  No  Header  Available;  Continue  (T  or  F):  ',$) 

053  FORMAT  (LI) 

054  FORMAT  ('  —  Write  Aborted  — ') 

55  FORMAT  ('  cHeader  Not  Updated  For  This  Scan:>‘) 

56  FORMAT  ('  <><>Do  You  Want  To  Update  Header?  ’,$) 

57  FORMAT  (Al) 

88  FORMAT  ('  : : Fi 1 e  Already  Exists::  *,6A1) 

89  FORMAT  ('  <><>  Do  You  Wish  To  [  Abort .Rename,  or  Continue]?  ',$) 
C 

IF  (KT.EQ.O)  TYPE  051  ! NO  DATA  CHECK 

IF  (KT.EQ.O)  RETURN 
C 

IF  (.NOT. HDR)  TYPE  052  ! IF  NO  HDR 

IF  (.NOT. HDR)  ACCEPT  053,ANS 
IF  ( .NOT.ANS)  RETURN 

C 

IF  (ISTYP. GE. 20)  GO  TO  888  I  HAS  HDR  BEEN  UPDATED 
TYPE  55 
TYPE  56 
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ACCEPT  57,1 

IF  (I.EQ.’Y')  CALL  SU8HDR 
C 

888  Tvn"  j4,LINE 1  !  TYPE  HDR 

TW  U04.LINE2 
TYPE  004, PAR AM 
TYPE  001 

C 

997  IF (L— 2)111,222, 333 

111  TYPE  009 

ACCEPT  002.FNMT 

IF  (FNMT ( 2 ) .EQ.32 )  TYPE  054  !  IF  BLANK  THEN  RETURN 

IF  (FNMT ( 2 ) . EQ.32)  RETURN 
FNMT ( 31 ) =0 

OPEN  (UNIT  =  13, NAME -FNMT , TYPE = 'OLD ' , FORM =' UNFORMATTED  1  , 
&  READONLY, ERR=1098) 

CLOSE  (UNI T  =  13 ,D ISP= 1  SAVE ' ) 

TYPE  88, (FNMT(Iin, 111  =  1,6) 

TYPE  89 
ACCEPT  57,1 

IF  (I.EQ.'R' )  GO  TO  997 
IF  (I. Eg. 'A')  GO  TO  1077 

1098  OPEN  (UNIT=13,NAME=FNMT ,TYPE= ' NEW ' ,FORM= ' UNFORMATTED ' , 

&  ERR=1U00) 

GOTO  200 
C 

222  TYPE  008 

ACCEPT  002.FNMB 
IF(FNMB(2). EQ.32)  TYPE  054 
IF (FNMB(2) .EQ.32)  RETURN 
FNMB( 31 ) =0 

OPEN  (UNIT=13,NAME=FNMB ,TYPE  =  'OLU 1 ,FORM= 1  UNFORMATTED1 , 
8,  READONLY,  ERR=2000) 

CLOSE  (UNIT=13,0ISP=' SAVE ' ) 

TYPE  88, (FNMB(III), 111=1,6) 

TYPE  89 
ACCEPT  57,1 
IF(I.EQ.'R')  GOTO  997 
IF(I.EQ.'A')GOTO  1077 

2000  OPEN  (UNIT=13,NAME=FNMB,TYPE='NEW' ,FORM=' UNFORMATTED' , 

8,  ERR=1000) 

GOTO  200 
C 

333  TYPE  007 

ACCEPT  002,FNMS 
IF(FNMS( 2) . EQ.32)  TYPE  054 
IF(FNMS(2). EQ.32)  RETURN 
FNMS( 31)=0 

OPEN  (UNIT=13,NAME=FNMS,TYPE  =  '0LD ' ,FORM= 1  UNFORMATTED ' , 
&  READONLY, ERR=3000) 


CLOSE  (UNIT=13,DISP=‘ SAVE 1 ) 

TYPE  88, (FNMS(III), 111=1,6) 

TYPE  89 
ACCEPT  57,1 
IF( I.EQ.'R* )GOTO  997 
IF(I.EQ.‘A')GOTO  1077 

OPEN  (UNIT=13,NAME=FNMB,TYPE='NEW' ,FORM= 1  UNFORMATTED ' , 
&  ERR=luOO) 

WRITE  (13)  LINE  1 
WRITE  (13)  LINE2 
WRITE  (13)  PARAM 

00  210  K1 = 1 ,KT 

WRITE  (13)  ARRAY(Kl.l) ,ARRAY(K1,2) 

CONTINUE 

WRITE  (13)  ARRAY (3603,1) .ARRAY (3603,2) 

WRITE  (13)  ARRAY (3604, 1 ) .ARRAY (3604,2) 

CLOSE  (UNIT=13,0ISP=,SAVE‘ ) 

RETURN 

TYPE  050 
GOTO  200 
END 


V.  .  "-v 


c*********************************************************************** 


c*************  THIS  SUBROUTINE  PRINTS  ANY  DESIRED  PORTION  ************ 
C *************  OF  A  DATA  FILE  ON  THE  "CRT"  SCREEN  .  ************ 

Q *********************************************************************** 

c 

SUBROUTINE  PRNTDF(UT,UB) 

VIRTUAL  UT (3604,2) ,UB(3604,2) 

INTEGER  XX 
C 

COMMON/ FLAGS/MT, MB, MS, MN,MST 
COMMON/WQY/XX 
C 

66  FORMAT (/,'  YOU  HAVE  NOT  READ  A  DATA  FILE  ,S0  CANNOT',/ 

+  ,'  EXECUTE  YOUR  COMMAND 

77  FORMAT (A2) 

78  FORMAT (/ , 1  ILLEGAL  FILE  SPECIFICATION  ,TRY  AGAIN 

87  FORMAT(/, '  ENTER  TYPE  OF  FILE  :  ',$) 

C 

85  TYPE  86 

86  FORMAT!/,'  TARGET  FILE  :  TF ',/ 


+ 

1 

* 

BACKGROUND  FILE 

BF ',/ 

+ 

t 

9 

SHPERE  FILE 

SF',/ 

+ 

1 

9 

CALIBRATED  FILE 

CF',/ 

+ 

1 

9 

<  FILE  "Y"  > 

YF',/ 

+ 

1 

9 

<  FILE  "X"  > 

XF',/) 

TYPE 

87 

ACCEPT  77, XX 
IF ( XX.EQ . ' TF ' )GOTO  25 
IF(XX.EQ.’BF')GOTO  30 
IF (XX.EQ. ' SF ' )GOTO  30 
I F ( XX . EQ . ' CF ' )GOTO  25 
IF ( XX.EQ. ' YF ' )GOTO  25 
IF(XX.EQ. ' XF ' )GOTO  30 
TYPE  78 
GOTO  85 

25  IF(MT.EQ.1)G0T0  26 
TYPE  66 

GOTO  99 

26  CALL  PNTOUT(UT) 

GOTO  99 

30  IF(MB.EQ.1)G0T0  36 

IF(MS.EQ.1)G0T0  36 
if  PE  66 
GOTO  99 

36  CALL  PNTOUT(UB) 

99  RETURN 

END 
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Q  ★★★★***  *  *★**  -k  *********************************************************  * 

c************  THIS  SUBROUTINE  DOES  THE  COMPUTATIONS  FOR  ********** 
c************  PRINTING  THE  DATA  SPECIFIED  BY  PRNTDF (ARRAY )  ********** 

q *********************************************************************** 

C 

SUBROUTINE  PNTOUT (ARRAY ) 

VIRTUAL  ARRAY (3604,2) 

C 

COMMON/ L I SFRQ/LOFQ, I UPFQ, INCRE 
COMMON/LOOP/JK, IK 
COMMON/ INPTS1/ALPHA1.ALPHA2 
COMMON/ ASPCTA/ ALPHA, DELTA I 
C 

60  FORMAT (F7.0) 

50  F  ORMAT (7X,F8.2,7X,F8.2,6X,F8.2) 

7q  FORMAT (/ , 1  ********************************************* 1 9 / 

+  ’aspect  angle  amplitude  PHASE  ',/ 

+  (degrees)  (dB"s)  (degrees)',/ 

+  1  **************  ************  ************  *  9/) 

10  FORMAT (/ , 1  ENTER  THE  INITIAL  VALUE  OF  ASPECT  ANGLE  ',/ 

+  , '  ALPHA1  *  ',$) 

20  FORMAT (/,*  ENTER  THE  FINAL  VALUE  OF  ASPECT  ANGLE  ',/ 

+  ,'  ALPHA2  =  ',$) 

C 

C  ALPHA1  &  ALPHA2  DEFINES  THE  INTERVAL  OF  ASPECT  ANGLE  SPECIFYING  THE 
C  PORTION  OF  A  DATA  FILE  TO  BE  PRINTED  OUT  . 

40  TYPE  10 

READ( 5,60,ERR=661 )ALPHA1 
IF(ALPHA1.LT.L0FQ)G0T0  2003 
GOTO  45 

2003  TYPE*,'  (!)  INITIAL  ASPECT  ANGLE  IS  SMALL  (!)' 

GOTO  40 

45  TYPE  20 

READ(5,60,ERR=663)ALPHA2 
IF (ALPHA2.GT. IUPFQ ) GOTO  2004 
GOTO  2005 

2004  TYPE*,'  (!)  FINAL  ASPECT  ANGLE  IS  LARGE  (!)' 

2005  DELTA1= INCRE/ 100. 

IK=( ( ALPHA 1-LOFQ) /DELTA  1 )  +  l 
JK=( (ALPHA2-L0FQ)/0ELTA1 )+l 

C  IK  H  JK  ARE  THE  CORRESPONDING  VALUES  OF  ARRAY  SUBSCRIPT  . 

TYPE  70 

DO  27  I=IK, JK 

ALPHA=( ( 1-1 )*UELTA1 )+LOFQ 

WRITE( 7, 50) ALPHA, ARRAY (1,1) .ARRAY (1,2) 


45 


27 


CONTINUE 
RETURN 

661  TYPE  662 

662  FORMAT (  / , 1  (*)  ILLEGAL  FORMAT  .TRY  AGAIN  .(*)',) 

GOTO  40 

663  TYPE  6b2 
GOTO  4t> 

RETURN 

END 
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0************ ********************** ************************************* 


c*************  THIS  SUBROUTINE  EDITS  THE  HEADER  OF  A  DATA  FILE  ******* 
0  ******************************* **************************************** 

C 

SUBROUTINE  EUTHDF 
C 

COMMON/FLAGS/MT ,MB ,MS ,MST 

C 

IF ( (MT.EQ. 1 ) .OR. (MB.EQ.l ) .OR. (MS.EO.l ) )GOTO  20 
TYPE  10 

10  FORMAT (  / , 1  YOU  HAVE  NOT  READ  A  DATA  FILE  .',/ 

+  ,'  SO  YOUR  COMMAND  IS  NOT  EXECUTABLE  .',/) 

GOTO  40 

20  CALL  SUBHUR 

40  RETURN 


SUBROUTINE  SUBHDR 


THIS  ROUTINE  GENERATES  THE  HEADER 


VARIABLES 

BYTE  CMU(70) ,CUR(60) .LINE  1(60) ,LINE2( 60) ,PARAM(60) 
BYTE  WOROl ( 30) ,W0RD2(30) 

DOUBLE  PRECISION  SCNTYP 
COMMON  /LISFRQ/  LOFQ, IUPFQ , INCRE 
COMMON  /MHDR/  LINE  1 ,LINE2 ,PARAM ,HDR 
COMMON  /FILE/  ITS.KT, ISTYP, IFLG 
COMMON  /SCNFCT/  DELTA, START 
LOGICAL  HUR 

FORMATS 

FORMAT  ('  ') 

FORMAT  ('  Line  #' , 1 1 , ‘ :  ',$) 

FORMAT  ( 70A1 ) 

FORMAT  (Q,31A1) 

FORMAT  ( 1  O' ,60A1 ) 

FORMAT  ('  —  Terminator  (#)  was  not  used  — ’) 
FORMAT  (‘  1 ,60A1 ) 

FORMAT  ('  -Line  #?',$) 

FORMAT  (II) 

FORMAT  ('  »Replace:  ',$) 

FORMAT  (20A1) 

FORMAT  ('  »With :  ’,$) 

FORMAT  ('  —  No  Such  Word  — ') 

FORMAT  ( 1 NL= 1 ) 

FORMAT  (14) 

FORMAT  ('  FF  = ' ) 

FORMAT  (15) 

FORMAT  ('  IN= 1 ) 

FORMAT  ('  TYP  = '  ) 

FORMAT  ('  »Replace:  ',$) 

FORMAT  ('  »With:  ',$) 

FORMAT  ( 30A1 ) 

FORMAT  ( 1 NA= 1 ) 

FORMAT  ('  FA  = ' ) 

FORMAT  (15) 

FORMAT  ('  IN= 1 ) 


o  O  O  UiOOO  O  O  C~i 


FORMAT  (12) 

IF  (ISTYP.LT. 20)  ISTYP=ISTYP+20  !  ISTYP  TELL  OF  HDR  UPDATE 

SET  3RD  LINE  PARAMETERS  FOR  FRQ  SCN 

IF  (M0D( ISTYP.2) .NE .0)  GO  TO  353 
ENCODE  (3,030,PARAM( 1 ) ) 

ENCODE  (4,031,PARAM(4))  KT 
ENCODE  (4,032,PARAM(8) ) 

ENCODE  (5,033,PARAM( 12) )  LOFQ 
ENCODE  (4,034,PARAM( 17 ) ) 

ENCODE  (5,033,PARAM(21) )  INCRE 
ENCODE  (5, 35, PAR AM (26) ) 

ENCODE  (2,55,PARAM(31 ) )  ISTYP 
ENCODE  (1 ,1  ,PARAM(33) ) 

GO  TO  354 

SET  3RD  LINE  PARAMETERS  FOR  AZIMUTH  SCN 

IF  (MOD( ISTYP,2).NE.l)  GO  TO  354 
ENCODE  (3,050,PARAM( 1 ) ) 

ENCODE  (4,031 ,PARAM( 4) )  KT 
ENCODE  (4,052,PARAM(8) ) 

ENCODE  (5,053,PARAM( 12) )  IFIX(START) 

ENCODE  (4, 054,PARAM( 17 ) ) 

ENCODE  (5,053,PARAM(21 ) )  INCRE 
ENCODE  (5, 35, PAR AM (26) ) 

ENCODE  (2,55,PARAM(31) )  ISTYP 
ENCODE  ( 1 ,1  ,PARAM(33) ) 

—  CHARACTER  EDITOR 

IF  (HDR)  GOTO  100 
DO  8  K=l,3 
TYPE  3  K 

IF  (K  ’.EQ.  1)  ACCEPT  10.LINE1 
IF  (K  .EQ.  2)  ACCEPT  10.LINE2 

IF  (K  .EQ.  3)  ACCEPT  11 , IZH2, (PARAM(K1 ) ,K1=34, IZH2+34) 
CONTINUE 
HDR=.TRUE . 

NPOS-1 

TYPE  12.LINE1 
TYPE  14.LINE2 
TYPE  14.PARAM 


TYPE  16 

READ  (5,17 ,ERR=105)  L 


IF  (L.EQ.O)  RETURN 
IF  (L.LT.l.OR.L.GT.3)  GOTO  105 
C 

00  110  K=1 ,60 

IF  (L.EQ.l)  CUR ( K ) =L I NE 1 ( K ) 

IF  (L.EQ.2)  CUR(K ) =L I NE 2 ( K ) 

IF  (L.EQ.3)  CUR(K)=PARAM(K) 

110  CONTINUE 

C 

TYPE  12, CUR 
ACCEPT  10,CMD 

IF  (CMD(l).Eq.'/')  GOTO  599 
C 

120  DO  200  N=1 ,70 

IF  (CMO(N)  .EQ.  '#')  GOTO  210 
IF  (CMD(N) .EQ. 'X* )  GOTO  150 
IF  (CMO(N) .EQ. ,®< )  GOTO  300 
IF  (CMO(N).EQ.1  ' )  NP0S=NP0S+1 
IF  (CMD(N).EQ.'  ')  GOTO  200 
GOTO  170 
C 

150  00  160  K=NPOS , 59 

CUR(K)=CUR(K+1) 

160  CONTINUE 

CUR(60)=32 
GOTO  200 
C 

170  00  180  K=1 ,60-NP0S 

CUR(61-K)=CUR(60-K) 

180  CONTINUE 

CUR(NPOS)=CMU(N) 

NP0S=NP0$+1 

C 

200  CONTINUE 

C 

210  CONTINUE 

00  220  K=1 ,60 

IF  (L.EQ.l)  LINE1(K)=CUR(K) 

IF  (L.EQ.2)  LINE2(K)=CUR( K) 

IF  (L.EQ.3)  PARAM(K)=CUR(K) 

220  CONTINUE 

GOTO  100 
C 

300  N=N+1 

IF  (N  .LE.  61)  GOTO  305 

TYPE  13 

GOTO  100 

305  IF  (CMO(N)  .EQ.  '#')  GOTO  210 

C 


50 


DO  310  K=1 ,60-NP0S 
CUR(61-K)=CUR(60-K) 

3.0  CONTINUE 

C 

CUR(NPOS)=CMO(N) 

NP0S=NP0S+1 
GOTO  300 
C 

C  —  WORO  SEARCH 

C 

599  00  598  Kl=l,60 

IF  (L.EQ.l)  CUR(K1)=LINE1(K1) 

IF  (L.EQ.2)  CUR(K1)=LINE2(K1) 

IF  (L.EQ.3)  CUR(K1)=PARAM(K1) 

598  CONTINUE 

C 

597  TYPE  36 

ACCEPT  40.W0RD1 
C 

TYPE  38 

ACCEPT  40.W0RD2 
C 

00  590  Kl=l ,60 
CMD(K1)=32 

590  CONTINUE 

C 

LW1=0 

LVJ2=0 

00  591  Kl=l ,30 

IF  (W0RD1(K1).NE.32)  IW1=LW1+1 
IF  (W0R02(K1 ) .NE.32)  LW2=LW2+1 

591  CONTINUE 
C 

KW=1 

00  600  Kl=l ,60 

IF  (KW.EQ.l)  IPT=K1 
IF  (CUR(Kl).NE.WORDl(KW))  KW=1 
IF  (CUR(K1 ) .NE .W0R01 (KW) )  GOTO  600 
IF  (Kl.EQ.l. OR. KW.EQ.l)  GOTO  601 
IF  ( C UR ( K 1 - 1 ) . NE . WOR D 1 { KW - 1 ) )  KW=1 
IF  (CUR (Kl-1 ) .NE .W0R01 (KW-1 ) )  GOTO  600 
601  CONTINUE 

CM0(K1 )=37 
KW=KW+1 

IF  (KW.GT.LW1)  GOTO  604 

600  CONTINUE 


C 

604 


KW=0 

DO  605  Kl=l ,60 


IF  (K1.LT.IPT)  CMD(K1 )=32 
IF  (Kl.GE.IPT.AND.CMD(Kl) .NE.37)  KW=KW+1 
IF  (Kl.GE.IPT. AND. CMD(Kl). NE.37)  CMD(K1)=W0RD2(KW) 
IF  (KW.EQ.IW2)  GOTO  606 
CONTINUE 


OOO  O  OOO  O  O  O  O  O  O  O  O  ►—  ooooooooo 


CCCCCCCCCCCCCCCCCC 

SUBROUTINE  PL0TS(AR , ITME , ISETS) 

INTEGER  ARP NT 

COMMON  /PVTPAR/  AMN,AMX,PMN,PMX,SL,SH 

COMMON  / FILE/  NSMP(2) , INTRV(2) ,NBACK,NUMFIL,ARPNT 

VIRTUAL  AR ( 1001 ,2,2) , ITME( 100,3,2) 

BYTE  TXT (6)  ! MESSAGE  BUFFER 

DIMENSION  VAL( 3) 

C 

C]]]]]]]]]]]]]]]]]]]]]]J]]]]]]]]]]]]]]]j]]]]]]]]]]]]]]]]]] 

C  QUICK  PLOT 

C]]]]]]]]]]]]]]]]]]]]]J]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] 


>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
This  routine  initializes  the  VT125  for  plotting 
by  drawing  the  brackets  and  labels 
»>>>>>>»>>>>>»>»»>>»>>>>>»»»>>>>>>>>»»»>>>>>> 

formats 

0  FORMAT  ('  ','No  timming  trigger  data') 


EXECUTABLE 


CALL  FRAME 

initialize  plot  limit  pointers 
SL=0. 

SH=NSMP(ARPNT) 

CALL  NUMBER  (SL,SH) 


ISTEP=0 

IF  (ISETS. EQ.l)  ISTEP=NSMP(ARPNT)/60. 
IF  ( ISTEP.LE . 1 )  ISTEP=1 
CALL  PLACEP(VAL.O) 

DO  200  1=1 ,NSMP(ARPNT ) , ISTEP 

abort  option  detection 

IQUIT=-1 

CALL  CRDETR(IQUIT) 

IF  (IQUIT.EQ.l)  RETURN 


VAL ( 1 ) =AR (1,1 ,ARPNT ) 

VAL(2)=AR(I,2,ARPNT) 

VAL  ( 3 )  =  I  - 1 

CALL  PLACEP(VAL.l) 

CONTINUE 

CALL  DRMOV(0,2/'S) 

IF  ( INTRV (ARPNT) .NE .0)00  TO  300 

TYPE  10 

RETURN 

00  310  I=1,INTRV(ARPNT) 

IF  ( I TME ( I ,2, ARPNT) .GE .0)  ITME( I ,2,ARPNT)=1 
IF  (ITME(I,2,ARPNT).LT.O)  ITME( I ,2,ARPNT)=-1 
IF  (I.EQ.l)  GOTO  208 

CALL  l)Rl)RW(  IF  I X  { ( ITME(  1 ,3,AKPNT)-1  )*600./NSMP(ARPNT) ) , 
t  245+ 1 TME ( 1-1,2 , AR  PNT ) * 1 5 ) 

CALL  DRURW( IFI X( ( I TME ( 1 ,3,ARPNT)-1 )*60Q./NSMP(ARPNT) ) , 
&  245+1 TME ( I ,2, ARPNT) *15) 

CONTINUE 

RETURN 


SUBROUTINE  ORBFRT (COMS,  LEN) 


C 

C  SUBROUTINE  "ORBFRT"  (FOR  'UEC  ReGIS  BuFfer  Routine')  BUFFERS  A 
C  SERIES  OF 

C  ReGIS  COMMANDS  FOR  EVENTUAL  FLUSHING.  THIS  ROUTINE  PREFIXES  EACH 
C  BUFFER 

C  FUL  OF  ReGIS  COMMANDS  WITH  THE  <ESC>Pp  'PLACE  DEVICE  IN  GRAPHICS 
C  MODE ' 

C  ReGIS  COMMAND.  WHEN  THE  OUTPUT  BUFFER  IS  FLUSHED  AFTER  A  COMPLETE 
C  ReGIS 

C  COMMAND-STRING  HAS  BEEN  RECIEVED  AND  THE  BUFFER  IS  FULL,  <ESC>®  IS 
C  SENT 

C  TO  TAKE  THE  ReGIS  DEVICE  OUT  OF  GRAPHICS  MODE.  IN  THE  PRESENT 
C  OUTPUT 

C  BUFFER  CONFIGURATION,  THE  SIZE  OF  THE  ENTIRE  BUFFER  IS  512  BYTES. 

C  PART 

C  OF  THE  BUFFER  IS  HELD  IN  RESERVE  TO  RECIEVE  CHARACTERS  WHILE  THE  FI 
C  FIRST 


C  PART  IS  BEING  FLUSHED.  THE  PARAMETER  'EOBPT '  HOLDS  THE  VALUE 
C  OF  THE 

C  SIZE  OF  THIS  "OVERFLOW"  BUFFER.  ITS  PRESENT  VALUE  IS  64. 

C 

LOG  I CAL* 1  INIT 

INTEGER*2  LEN  !  LENGTH  OF  INCOMING 

C  COMS 


BYTE  COMS (LEN ) 
C 


INTEGER*2  COMIDX 
INTEGER*2  BUFIDX 
INTEGER*2  EOBPT 

C 

1NTEGER*2  MODE 

C 


I NTEGEK*2  BUFLEN 

C 


BYTE  BUFFER(bl2) 

C 


!  INCOMING  COMMAND - 
STRING 

!  COMS  ARRAY  INDEX 
!  BUFFER  ARRAY  INDEX 
!  SIZE  OF  OVERFLOW 
BUFFER 

!  BUFFERING  MODE  (0=NONE,  1=BUFFERING 
ENABLED) 

!  LENGTH  OF  OUTPUT 
BUFFER 

!  OUTPUT  BUFFER  IS 
BUFLEN  LONG 


COMMON  /BLOCKI/MOOE, BUFIDX 
COMMON  /BLOCK2/BUFFER 


!  COMMON  BLOCK1 
!  COMMON  BLOCK2 


DATA  EOBPT  /  64  / 
DATA  BUFLEN  /  612  / 
DATA  INI F  /  .FALSE. 


!  LENGTH  OF  OVERFLOW  BUFFER  IS  64  BYTES 
!  LENGTH  OF  OUTPUT  BUFFER  IS  512  BYTES 
!  INITIALIZE  FLAG  —ASSUMED  TO  BE 
UNINITIZLIZEU 


BUFFER(l)  =  27 
BUFFER (2)  =  80 
BUFFER  3)  =  112 


"<ESC>" 

l»p»l 


c 

c 

c 

c 

c 


c 

c 

c 

10 

c 

20 

c 

c 


c 

c 

30 

C 

C 

40 

C 

C 

C 


C 

50 

C 


C 

C 


+ 


IF  (MODE  .NE.  1)  !  IF  BUFFERING  IS  NOT 

DESIRED 

GOTO  100  !  PLACE  ReGIS  TERMINAL  COMMANDS  AROUND  THE  COMMAND¬ 

STRING 


IF  (INIT)  GOTO  10  !  IF  ROUTINE  HAS  NOT  BEEN 

INITIALIZED 

INIT  =  .TRUE.  !  INITIALIZE  THE  ROUTINE 

BUFIDX  *  4  !  NOW  POINTS  PAST  "<ESC>Pp"  AT  BEGINNING 

BUFFER 

ENDIF 


COMIDX  =1  !  NOW  POINTS  TO  BEGINNING  OF 

COMS 

IF  (BUFIDX. GE.((BUFLEN-E08PT)+1))  GOTO  30  !  DO  WHILE  ... 

BUFFER (BUFIDX)  =  COMS(COMIDX)  !  BUFFER  GETS  1  CHARACTER  FROM 

COMS 

BUFIDX  =  BUFIOX+1  !  INCREMENT  BUFFER 

POINTER 

COMIDX  =  COMIDX+1  !  INCREMENT  COMS  POINTER 

IF  ( (COMIDX-1 )  .GE.  LEN)  GOTO  999  !  WHEN  COMPLETELY  DUMPED, 

RETURN 

GOTO  20  !  ENDWHILE 


INIT  =  .FALSE. 


!  FLAG  ROUTINE  FOR  RE¬ 
INITIALIZATION 


IF  ((COMIDX-1)  .GE.  LEN)GOTO  50 

BUFFER(BUFIDX)  =  COMS(COMIDX) 

BUFIDX  =  BUFIDX+1 

COMIDX  =  COMIDX+1 
GOTO  40 


!  DO  WHILE  COMS  IS  NOT  COMPLETELY 
DUMPED 

!  CONTINUE  TO  FILL  OVERFLOW 
BUFFER 


!  INCREMENT  BUFFER 
POINTER 

!  INCREMENT  COMS  POINTER 
!  ENDWHILE 


BUFFER(BUFIDX)  =  27 

BUFIDX  =  BUFIDX+1 
BUFFER(BUFIOX)  =  92 


!  AT  END  OF  THE  SERIES  OF  COMMANDS, 
APPEND 

!  INCREMENT  BUFFER  POINTER 
!  ASCII  "<ESC>®" 


CALL  ORFLSH 


!  FLUSH  THE  OUTPUT  BUFFER 


GOTO  999  !  SKIP  PAST  NOBUFFERING  ROUTINE 

C 

C - NOBUFFERING  ROUTINE— INSERTS  "<ESC>Pp"  BEFORE  A  REGIS  COMMAND- 

C  STRING,  AND 

C - "<ESC>®"  AFTER  THE  COMMAND-STRING.  THESE  ReGIS  STRINGS  PUT  THE 

C  ReGIS  ; 

i 
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DEVICE  INTO  AND  OUT  OF  GRAPHICS  MODE,  RESPECTIVELY 


BUFIDX  =  3  !  WILL  POINT  PAST  "<ESC>Pp“  AT  BEGINNING  OF 

BUFFER 


DO  110  COMIDX  =  l.LEN 
BUFFER (BUF IDX+COMIDX) 
CONTINUE 
BUFIDX  =  LEN+4 

BUFFER(BUFIDX)  =  27 
BUFIDX  =  BUFIDX+I 
BUFFEK(BUFIDX)  =  92 


!  PLACE  COMS  IN  BUFFER,  BEHIND  “<ESC>Pp 
COMS (COMIDX)  ! 

!  NEXT  COMIDX 

!  POINTS  TO  NEXT  CHARACTER  POSITION  IN 
BUFFER 

!  NEXT  CHARACTER  IN  BUFFER  IS  "<ESC>" 

!  INCREMENT  BUFFER  POINTER 
!  NEXT  CHARACTER  IN  BUFFER  IS 


CALL  DRFLSH 


!  FLUSH  THE  OUTPUT 
BUFFER 


RETURN 


o  o  o  o 


SUBROUTINE  URBUFR (DRMODE) 


"ORBUFR"  SETS  THE  BUFFERING  MODE  FLAG  FOR  OUTPUT  BUFFERING  CONTROL 
DRMODE:  0=N0BUFFERING,  1=BUFFERING  ENABLED,  2=FLUSH  OUTPUT  BUFFER 


C 

C 

C 

C 


C 

C 


C 


C 


C 

C 


C 


INTEGERS  DRMODE 
INTEGER*2  BUFIDX 
INTEGER*2  MODE 

LOGICAL*!  LTFLSH 


!  PASSED  BUFFERING  MODE 
!  BUFFER  INDEX  POINTER 
!  BUFFERING  MODE— ASSUME  BUFFERING 
ENABLED 

!  "LET  FLUSH"  FLAG 


INTEGER*2  BUFLEN 

BYTE  BUFFER(512) 

COMMON  /BLOCK1/MODE, BUFIDX 
COMMON  /BLOCK2/BUFFER 
DATA  BUFLEN  /  512  / 


!  LENGTH  OF  OUTPUT 
BUFFER 

!  OUTPUT  BUFFER  IS 
BUFLEN  LONG 
!  COMMON  BLOCK1 
!  COMMON  BL0CK2 

!  LENGTH  OF  OUTPUT  BUFFER  IS  512 
BYTES 


IF (DRMODE  .NE.  2)  MODE  =  DRMODE  !  RESET  MODE 

IF  (DRMODE  .NE.  0. AND. DRMODE  .NE.  1  !  IF  AN  INVALID  MODE  IS 

GIVEN 

+  .AND.DRMODL  .NE.  2)  M0DE=1  !  ASSUME  A  MODE  OF  1  (=  BUFFERING  ENAB 

ENABLED) 

IF  (MODE  .EQ.  1)  LTFLSH  =  .TRUE.  !  ALLOW  OUTPUT  BUFFER  FLUSHING 
IF  (MODE  .EO.  0)  LTFLSH  =  .FALSE.  !  DISALLOW  OUTPUT  BUFFER  FLUSHIN 

FLUSHING 

!  IF  NO  FLUSH  REQUESTED,  RETURN 
!  IF  BUFFER  FLUSHING  IS  ALLOWED 
!  NEXT  BYTE  IN  BUFFER  GETS 
"<ESC>" 

!  POINT  TO  NEXT  AVAILABLE  BYTE 
!  BYTE  GETS 


IF  (DRMODE  .NE.  2)  RETURN 
IF  (.NOT.  LTFLSH)  RETURN 
BUFFER(BUFIDX)  =  27 

BUFIDX  =  BUFIDX+1 
BUFFER(BUFIDX)  =  92 


!  FLUSH  THE  ENTIRE  OUTPUT  BUFFER 
!  ENDIF 

RETURN 

END 


CALL  DRFLSH 
C  ENDIF 
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o  o  o  o  cv 


•b 


i 


SUBROUTINE  ORCOLR(IC) 

C 

C  SUBROUTINE  ORCOLR  ASSIGNS  A  LINE  COLOR  THAT  A  ReGIS  DEVICE  WILL 
C  DRAW  IN 

C 


BYTE  IC 
BYTE  COMS(5) 

C 

C--COLOR :  0=DARK,  1=BLUE,  2=RED, 
C  7  =  WHITE 
C 

DATA  COMS  /  87,  40,  73, 

+  0, 

+  41  / 

ENCODE ( I, 100, COMS (4) )  IC 


!  COLOR  (SEE  TABLE  BELOW) 

!  COMMAND-STRING  IS  5  BYTES  LONG 

3=MAGENTA,  4=GREEN,  S=CYAN,  6=YELL0W, 


!  ASCII  "W(I 
!  ASCII  NULL  CHARACTER 
!  ASCII  ")“ 

!  CONVERT  CONTENTS  OF  IC  TO 
ASCII 


i 


c 

100 

c 


COMMAND-STRING  NOW  LOOKS  LIKE:  W ( I i ) 

WHERE  i  IS  THE  SELECTED  WRITING  COLOR  [INTENSITY], 


CALL  URBFRT (COMS, 5)  !  WRITE  COMS  TO  ReGIS  DEVICE  VIA  THE  ReGIS  BU 

BUFFER 


FORMAT (II) 


RETURN 

END 


a 


89 


w  • 


j 

i 

4 


.  i 


o  o  o  o  o  o  o 


SUBROUTINE  DRDRW(IX,IY) 


C 

C 

C 

C 

C 

C 

C 

C 


C 


C 


SUBROUTINE  DRDRW  DRAWS  A  LINE  (VECTOR)  FROM  THE  PRESENT  COORDINATE 

POSITION 

OF  THE  GRAPHICS 

CURSOR  ON  A  ReGIS  DEVICE  TO  THE  COORDINATE  POSITION  GIVEN  BY  THE 
PARAMETERS  IX  AND  IY. 

THE  GRAPHICS  CURSOR  IS  LEFT  AT  POSITION  (IX, IY). 


INTEGERS  IX 
INTEGERS  IY 
BYTE  COMS (12) 

DATA  COMS  /  86,  91, 

+  0,  0,  0,  0, 

+  44, 

+  0,  0,  0,  0, 

+  93  / 

ENC0DE(4,100,C0MS(3) )  IX 


ENCODE (4, 100, COMS (8) )  IY 


!  X-COOROINATE 
!  Y-COORDINATE 

!  COMMAND-STRING  IS  12  BYTES 
LONG 

!  ASCII  “V[" 

!  ASCII  NULL  CHARACTERS 
!  ASCII 

!  ASCII  NULL  CHARACTERS 
!  ASCII 

!  CONVERT  CONTENTS  OF  IX  TO 
ASCII 

!  CONVERT  CONTENTS  OF  IY  TO  ASCI 
ASCII 


COMMAND -STRING  NOW  LOOKS  LIKE:  V[< I X> , < I Y>] 

WHERE  <IX>  AND  <IY>  ARE  THE  ASCI  I -CONVERTED  CONTENTS  OF  IX  AND  IY, 
•RESPECTIVELY; 

PADDED  ON  THE  LEFT  WITH  BLANKS  IF  NECESSARY  (LENGTH  OF  4). 

CALL  DRBFRT (COMS , 12 )  !  WRITE  COMS  TO  ReGIS  DEVICE  VIA  THE  ReGIS 

C  BUFFER 

100  FORMAT (14) 

C 

RETURN 

END 


60 


o  o  o 


SUBROUTINE  DREGIS(COMS.LEN) 


SUBROUTINE  DREGIS  WRITES  A  ReGIS  COMMAND-STRING  TO  A  ReGIS  DEVICE. 


INTEGER*4  LEN 


C 

BYTE  COMS (LEN) 
C 
C 


!  LENGTH  OF  ReGIS 
COMMAND 

!  COMMAND -STRING  IS 
'LEN'  LONG 


CALL  DRBFRT(COMS.LEN)  !  WRITE  COMS  TO  ReGIS  DEVICE  VIA  THE  ReGIS 
C  BUFFER 

C 


RETURN 


o  o  o  o  o 


SUBROUTINE  URFLSH 


SUBROUTINE  "ORFLSH"  FLUSHES  THE  ReGIS  OUTPUT  BUFFER,  GIVEN  AN  INDEX 
THAT 

POINTS  TO  THE  LAST  CHARACTER  TO  BE  READ  INTO  THE  BUFFER  (BUFIDX). 


INTEGER*2  MODE 

INTEGERS  BUFIDX 

INTEGERS  BUFLEN 
C 

BYTE  BUFFER(512) 

C 

C 

COMMON  /BLOCK1/MODE, BUFIDX 

COMMON  /BLOCK2/BUFFER 
C 

DATA  BUFLEN  /  512  / 

C 

C 

CALL  QIO(BUFFER, BUFIDX)  ! 

BUFIDX  =  4 
C 
C 


!  BUFFERING  MODE 
!  BUFFER  ARRAY  INDEX 
!  LENGTH  OF  OUTPUT 
BUFFER 

!  OUTPUT  BUFFER  IS 
BUFLEN  LONG 

!  COMMON  BLOCK1 
!  COMMON  BLOCK2 

!  LENGTH  OF  OUTPUT  BUFFER  IS  512 
BYTES 

THE  ReGIS  OUTPUT  BUFFER 

!  RESET  BUFFER  INDEX 
POINTER 


RETURN 


<r>  c~>  o 


SUBROUTINE  DRINIT 


C 

C  SUBROUTINE  DRINIT  PERFORMS  THE  FOLLOWING  ON  A  ReGIS  DEVICE  : 
C  ERASES  THE  SCREEN,  SETS  THE  “PEN"  COLOR  TO  WHITE,  HOMES  THE  GRAPHICS 
C  CURSOR  TO  (0,0)  [ULC],  SETS  THE  SCREEN  COLOR  TO  “DARK",  POSITIONS 
C  THE  TEXT  CURSOR  AT  THE  BOTTOM  OF  THE  SCREEN,  CLEARS  TEXT  FROM  THE 


C  SCREEN,  SETS  THE  DEVICE  TO  ANSI  MODE,  ASSUMES  OUTPUT  BUFFERING,  ReGIS 
C  TEXT  SIZE  OF  1,  HEIGHT  OF  2,  DIRECTION  OF  0  DEGREES,  AND  NO  ITALICS. 

C 

BYTE  COMS( 52)  !  COMMAND-STRING  IS  52  BYTES 

C  LONG 


DATA  FOR  COMS  IS  ASCII  CHARACTER  CODES 


DATA  COMS 

C 

+ 

+ 

+ 

+ 

+ 

+ 

+ 

+ 

+ 


/  27, 

60, 

27, 

91, 

50, 

27, 

91, 

50, 

27, 

80, 

112 

32, 

83, 

40, 

32, 

87, 

40, 

32, 

80, 

91, 

32, 

83, 

40, 

32, 

84, 

40, 

32, 

84, 

40, 

27, 

92  / 

!  "<ESC><" 


MODE 

48, 

66, 

74, 

69, 

41, 

73, 

55, 

41 

48, 

44, 

48 

73, 

48, 

41 

72, 

50, 

41 

73, 

48, 

41 

IS  ReGIS  FOR  " 


"<ESC>[20B 
"<ESC>[2J " 
"<ESC>Pp" 

"  S(E)“ 

"  W  ( 1 7 ) " 

"  P[0,0]“ 

"  S(IO)“ 

"  T(H2)“ 

“  T  ( 1 0 ) " 
"<ESC>®“ 


ENTER  ANSI 


II 


CALL  QI0(C0MS,52) 
CALL  DRBUFR(O) 
CALL  DRSTXT (1,0) 


!  WRITE  COMS  TO  ReGIS  DEVICE 
!  NO  OUTPUT  BUFFERING 
!  ASSUME  TEXT  HEIGHT  OF  1, 
DIRECTION  0 


CALL  DRBUFR(I) 


!  ASSUME  OUTPUT  BUFFERING  IS 
DESIRED 


RETURN 


ooooooo  o  o  oooo 


SUBROUTINE  DRMOV(IX,IY) 


SUBROUTINE  URMOV  POSITIONS  THE  ReGIS  DEVICE  GRAPHICS  CURSOR 
AT  THE  COORDINATES  GIVEN  BY  THE  PARAMETERS  GIVEN  BY  IX  AND  IY. 


INTEGERM  IX 
INTEGER*4  IY 
BYTE  COMS ( 12 ) 

DATA  COMS  /  80,  91, 

+  0,  0,  0,  0, 

+  44, 

+  0,  0,  0,  0, 

+  93  / 

ENCODE  (4,100,C0MS(3))  IX 

ENCODE  (4,100,C0MS(8) )  IY 


!  X-COORDINATE 
!  Y-COORDINATE 

1  COMMAND-STRING  IS  12  BYTES 
LONG 

!  ASCII  “P[" 

!  ASCII  NULL  CHARACTERS 
!  ASC II  "  11 

!  ASCII  NULL  CHARACTERS 
!  ASCII 

!  CONVERT  CONTENTS  OF  IX  TO 
ASCII 

!  CONVERT  CONTENTS  OF  IY  TO 
ASCII 


COMMAND-STRING  NOW  LOOKS  LIKE:  P[<IX>,<IY>] 

WHERE  <IX>  AND  <IY>  ARE  THE  ASCII-CONVERTED  CONTENTS  OF  IX  AND  IY, 
RESPECTIVELY; 

PADDED  ON  THE  LEFT  WITH  BLANKS  IF  NECESSARY  (LENGTH  OF  4). 

CALL  DRBFRT (COMS, 12)  !  WRITE  COMS  TO  ReGIS  DEVICE  VIA  THE  ReGIS 

C  BUFFER 

100  FORMAT (14) 

C 

RETURN 

END 


o  o  o  o  o 


SUBROUTINE  URTERM 


SUBROUTINE  "DRTERM"  ERASES  A  ReGIS  DEVICE ' S  GRAPHICS  MEMORY  AND 
FLUSHES 

THE  ReGIS  OUTPUT  BUFFER. 


C 


C 


C 

C 

C 

C 


INT£GER*2  BUFIDX 
INTEGER*2  BUFLEN 
INTEGER*2  MODE 
BYTE  C0MS(9) 

BYTE  BUFFER(512) 

COMMON  /BLOCK1/MODE, BUFIDX 
COMMON  /BLOCK2/BUFFER 

DATA  BUFLEN  /  512  / 

DATA  COMS  /  27,  80,  112, 

+  83,  40,  69,  41, 

+  27,  92  / 


!  BUFFER  ARRAY  INDEX 
!  LENGTH  OF  OUTPUT  BUFFER 
!  BUFFERING  MODE 

!  COMMAND-STRING  IS  9  BYTES  LONG 
!  OUTPUT  BUFFER  IS  BUFLEN  LONG 

!  COMMON  BL0CK1 
!  COMMON  BL0CK2 

!  LENGTH  OF  OUTPUT  BUFFER  IS  512 
BYTES 

!  "<ESC>Pp" 

!  "S(E)" 

!  "<ESC>®" 


CALL  QI0(C0MS,9) 
BUFIDX  =  4 


!  WRITE  COMS  TO  ReGIS  DEVICE 
!  RESET  BUFFER  INDEX  POINTER 


RETURN 

END 


i 

i 


I 


ooo  oc~.oo  oc~>  ooo<~.  ooooooo 


SUBROUTINE  ORSTXT(SIZE,  ANGLE) 


"ORSTXT"  SETS  THE  SIZE  AND  DIRECTION  THAT  ReGIS  TEXT  WILL  BE 
DRAWN  IN.  THE  SIZE  MAY  BE  ANY  INTEGER  BETWEEN  0  AND  16,  AND 
THE  DRAWING  ANGLE  MAY  BE  ANY  INTEGER  VALUE  BETWEEN  -360  AND 
360  DEGREES.  ReGIS  WILL  TAKE  THE  ANGLE  TO  BE  THE  NEAREST 
MULTIPLE  OF  45  DEGREES. 

INTEGER*2  SIZE  !  HOLDS  DESIRED  TEXT 

SIZE 

INTEGERS  ANGLE  !  HOLDS  DESIRED  DIRECTIO 

DIRECTION 

BYTE  C0MS(20)  !  HOLDS  ReGIS  COMMAND¬ 

STRING 


DATA  COMS  /  84, 

40, 

68, 

!  ASCII 

"T(D‘ 

+ 

o. 

o, 

o, 

o. 

!  ASCII 

NULL 

CHARACTERS 

+ 

41, 

!  ")" 

+ 

40, 

83, 

!  "(S" 

+ 

o. 

o. 

!  ASCII 

NULL 

CHARACTERS 

+ 

41, 

!  ASCII 

II  J  II 

+ 

40, 

68, 

!  "(D" 

+ 

o. 

o. 

o. 

o. 

!  ASCII 

NULL 

CHARACTERS 

+ 

41 

/ 

!  ASCII 

II  j  II 

IF  ((SIZE  .LT.  0)  .OR.  (SIZE  .GT.  16))  SIZE  =  1 
IF  ((ANGLE  .LT.  -360)  .OR.  (ANGLE  .GT.  360))  ANGLE  =  0 

CONVERT  CONTENTS  OF  "SIZE"  TO  ASCII  AND  INSERT  IN  COMS 
ENCODE  (2,  100,  COMS(ll))  SIZE 

CONVERT  CONTENTS  OF  "ANGLE"  TO  ASCII  AND  INSERT  IN  COMS 
ENCODE  (4,  200,  COMS (4))  ANGLE 

ENCODE  (4,  200,  COMS (16))  ANGLE 

COMS  NOW  LOOKS  LIKE:  T(Ddi rection)(Ssize)(Ddi rection) 

CALL  DR8FRT(C0MS ,20)  !  WRITE  TO  ReGIS  DEVICE 

C 

100  FORMAT (12) 

200  FORMAT (14) 

C 

RETURN 

END 


66 


o  o  o  o 


* 


ft 


ft 


T  " 


u 


i 


c 


c 

c 


c 


c 


10 

c 

c 

c 

c 

c 


SUBROUTINE  DRTEXT(TEXT,  LEN) 

"DRTEXT"  PRINTS  ReGIS-GENERATEO  TEXT  ON  A  ReGIS  DEVICE.  THE 
MAXIMUM  LENGTH  OF  "TEXT"  IS  85  CHARACTERS. 


INTEGER*2  LEN 

BYTE  TEXT ( 1) 
BYTE  COMS (88) 


!  LENGTH  OF  INCOMING 
STRING 

!  HOLDS  INCOMING  STRING 
!  HOLDS  OUT-GOING  ReGIS 
STRING 


COMS(l)  =  84 
COMS (2)  =  39 

IF  (LEN  .LE.  0)  RETURN 
IF  (LEN  ,GT.  85)  LEN  =  85 

DO  10  I=3,LEN+2 

COMS(I)  =  TEXT (1-2) 
CONTINUE 

C0MS(LEN+3)  =  39 


CALL  DRBFRT (COMS.LEN+3) 


!  ASCII  "T" 

!  ASCII  . 

!  NO  TEXT  PRINTED 
!  MAX.  LENGTH  IS  85 

!  PACK  TEXT  INTO  COMS 

!  NEXT  I 

!  LAST  CHAR.  IN  COMS  IS 

II  I  It 


!  WRITE  COMS  TO  ReGIS 
DEVICE 


RETURN 


END 


< 
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SUBROUTINE  qiO(COMS.LEN) 


C 

C  SUBROUTINE  QIO  WRITES  THE  CONTENTS  OK  A  CHARACTER  BUFFER  TO 
C  AN  I/O  CHANNEL,  GIVEN  THE  ADDRESS  OF  THE  BUFFER  AND  ITS  LENGTH. 

C  THE  BUFFER  MUST  BE  A  BYTE  ARRAY.  THIS  ROUTINE  IS  WRITTEN  IN  VAX-11 
C  FORTRAN. 

C 

INTEGERS  LEN  !  HOLDS  LENGTH  OF  COMMAND -STRING 

BYTE  COMS(l)  !  HOLDS  VALUE  OF  COMMAND -STRING 

C 

CUMS(LEN+1)=128 
CALL  PRINT(COMS) 

RETURN 

END 


c 

c 


SUBROUTINE  FRAME 
Executable 


CALL  DREGIS  (20H;S(A[0,479][767,0]) ; ,20) 


!Set  up  vtl25 


Draw  frames 

00  100  1=1,5 
Il=(I-l)*50+275 
CALL  DRM0V(0,I1) 

CALL  DR0RW(600,I1) 

CALL  0RM0V(0, 11-250) 
CALL  DRDRW(600, 11-250) 
I 1=( I-l)*150 
CALL  ORMOV (11,275) 

CALL  ORORW( 11,475) 

CALL  DRM0V(I1,25) 

CALL  0R0RW(I1,225) 
CONTINUE 

CALL  ORMOV  (615,35) 
CALL  ORTEXT  ('AMP', 3) 
CALL  ORMOV  (615,310) 
CALL  ORTEXT  ('PHA',3) 

RETURN 

ENO 


! Frame  loop> 
[Upper  hori zonal 


[Lower  horizonal 


FV-V"  -V  _n'" 


[Vertical 


[Label  the  vertical  axies 


oooo^ooo  oooooo  oooo 


SUBROUTINE  PLACEP( VAL, ITYPE) 


II  II  II  II  II  II  II  II  II  It  II  II  II  II  II  II  II  II  II  II  II  II  II  II  H  II  II  II  M  H  H  H  II  II  II  H  II  H  II  II  II  II  II  II  II  II  II  II  II  II  II  H  II  II  II  II  II  II 

This  routine  is  a  point  plotting  routine 
that  requires  data  to  be  sent  through  VAL 

and  an  initialization  call  with  VAL  undetermined 
and  ITYPE=0.  ITYPE  equal  I  for  plotting. 

II  II  II  II  II  II  ti  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  it  II  il  II  II  H  H  II  >1  II  H  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  H  H  II 

common  and  data  definition 


■-1 

3 


INTEGER  ARPNT ,ALAST , PLAST ,SLAST 
UIMENSION  VAL (3) 

COMMON  /PVTPAR/  AMN,AMX,PMN,PMX,SL,SH 
COMMON  /PARPLT/  S1L,S1H,ALAST, PLAST, SLAST 
&  ,AFCTOR,PFCTOR,XFCTOR 


formats 

0  FORMAT  (‘  ','****  invalid  mode  in  placep  routine') 

I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I 

I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  •  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I 

executable  code 


I=ITYPE+1 

GO  TO  (100,200)  I  [execute  type  of  input 

C 

TYPE  10  [input  type  error 

RETURN  Ireutrn  /nothing  done/ 

C 

100  ALAST=25  [initialize  values  to  beginning  of  plot 

PLAST=27S  !amp,pha,xaxis 

SLAST =0 

AFCT0R=200./(AMX-AMN)  [seal  factors  set  for  all  axis 
PFCT0R=200./ (PMX-PMN) 

XFCT0R=600./ (S1H-S1L) 

RETURN  [initializing  done 

C 

200  CALL  DRMOV(SLAST.ALAST)  [move  to  last  amplitude  position 

IX=( VAL(3)-S1L)*XFCT0R  [calculate  next  xaxis  position 

ALAST=( VAL ( 1 ) -AMN )*AFCT0R+25  [calculate  next  amp  position 

CALL  DRDRW  (IX.ALAST)  [draw  to  new  point 

CALL  ORMOV  (SLAST, PLAST)  [move  to  last  phase  position 

PLAST=( VAL(2)-PMN)*PFCTOR+27S  [find  new  phase  point 
SLAST=IX  [set  to  new  xaxis  position 

CALL  DRORW(SLAST, PLAST)  [draw  to  new  phase  point 

RETURN  ! [done  with  single  point  drawing 

C 

ENO 


J 


3 


70 


o  o  o  o 


SUBROUTINE  CLRCRT 


II  II  ll  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II  II 

This  routine  clears  the  CRT  screen  and  the 
plotting  buffers. 

il  il  ii  H  ll  ll  ll  ll  ll  ll  ll  ii  ll  ll  ll  ll  II  II  II  ll  II  ll  ll  ll  II  II  II  II  11  II  II  II  II  ll  ll  ll  ll  ll  II  II  II  ll  II  II  ll  ll  ll  II  II  ll  ll  ll  ll  II  ll  II  ll 

CALL  DRINIT 
CALL  DRTERM 
RETURN 


OOOOOOOC-JOOOO 


SUBROUTINE  NUMBER (LOW, HIGH) 


i  (  i  i  t  i  i  i  i  I  i  i  i  i  t  l  i  •  t  i  i  l  i  i  i  i  i  I  i  i  I  i  i  «  i  i  i  l  l  l  i  I  i  I  I  I  i  i  i  i  i  i  I  i  I  i  i  i  I  i  i  i  i  i 

This  routine  lables  the  x-axis  for  plots  on  the  CRT 
The  low  and  high  values  input  are  real*4  and  are  used 
as  end  points  for  the  labeling  and  calculation  of 
placing  of  points. 


I  I  I  I  I  I  I  I  (  I  I  I  f  I  I  I  I  I  I  I  (  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  *  I  I  I  I  I  I  I  I  I  I  I  I  I  I  I  •  I  I  I  I  I  I  I  I  I 


common  data  and  data  definition 

REAL  LOW, HIGH 
COMMON  /PARPLT/  S1L.S1H 
COMMON  /PVTPAR/  AMN,AMX,PMN,PMX 
BYTE  TXT ( 10) 

C 

C  formats 

10  FORMAT (F5.2) 

11  FORMAT  (F6.1) 

12  F0RMAT(F5.0) 

C 

C  executable  code 

C 

S1L=L0W 

S1H=HIGH 

DELTAS=(SlH-SlL)/4. 

DELTAA=(AMX-AMN)/4. 

DELTAP=(PMX-PMN)/4. 

00  100  1=1,5 

ENCODE  (5, 12, TXT)  SlL+( I-1)*0ELTAS 
CALL  ORMOV ( ( I-l)*145,18) 

CALL  ORTEXT  (TXT, 5) 

CALL  DRM0V(( I-l)*145,268) 

CALL  DRTEXT  (TXT, 5) 

ENCODE  (6, 11, TXT)  AMN+( 1-1 )*DELTAA 
CALL  DRM0V(610,25+( 1-1 )*50) 

CALL  DRTEXT  (TXT, 6) 

ENCODE  (6, 11, TXT)  PMN+( I-1)*DELTAP 
CALL  DRM0V(610,275+( 1-1 )*50) 

CALL  DRTEXT  (TXT, 6) 

100  CONTINUE 
RETURN 
END 


72 


c***********  jhIS  SUBROUTINE  PREFORMS  THE  SUBTRACTION  OF  TWO  ********* 


c***********  oat A  FILES  .  ********* 

0 *************************************************************** ******** 

c 

SUBROUTINE  SUBTOF(UT.UB) 

VIRTUAL  UT (3604,2) ,U8(3604,2) 

INTEGER  S 
C 

COMMON/FILE/ ITSl.KT 
COMMON/ANSFR/S 
COMMON/FLAGS/MT ,MB ,MS ,MN,MST 
COMMON/ KRSB/ I JK 
C 

I  JK=0 
TYPE  10 

10  FORMAT (/ , '  SUBTRACTION  WILL  BE  PREFORMED  IN  THE  FOLLOWING',/ 

+  ORDER  :  <  FILE  "Y"  >  =  <  FILE  "Y"  >  -  <  FILE  "X"  >  ,',/ 

+  THE  RESULT  WILL  BE  STORED  IN  FILE  "Y" 

TYPE  11 

11  FORMAT (/ ,5X, 1  (*)  DEFINE  FILE  "X"  (*)  ',/) 

CALL  SUBREA(UB,4) 

IF(IJK.E0.1)RETURN 
I  JK=0 
TYPE  12 

12  FORMAT (/ ,5X, 1  (*)  DEFINE  FILE  "Y"  (*)  ',/) 

CALL  SUBREA(UT,5) 

IF ( I JK.EO.l) RETURN 
I  JK=0 

FCT=57.2958 

C  THIS  DO-LOOP  COMPUTES  THE  DIFFERENCE  . 

DO  35  K=1 ,KT 

RTY=10,0**(UT(K,l)/20,0) 

RBX=10.0**(UB(K,l)/20.0) 

PTY=UT(K,2)/FCT 
PBX=UB (K,2)/FCT 

RL=(RTY*COS(PTY ) )-(RBX*C0S(P6X) ) 

CX=(RTY*SIN(PTY) ) -(RBX*SIN(PBX) ) 

A=(RL**2.0)+(CX**2.0) 

IF (A.EQ.O)GOTO  3004 
GOTO  3005 

3004  TYPE*,'  X  =  Y  AT  DATA  POINT  #',K 
UT (K, 1)=UT(K-1 , 1) 

UT (K,2) =UT (K-l ,2) 

GOTO  35 

3005  UT (K, 1 )=10.0*(AL0G10(A) ) 

UT (K,2)=FCT*(ATAN2(CX,RL) ) 


CONTINUE 


FORMAT (10A1) 

TYPE  864,'  ',1799 
TYPE  20 

FORMAT {/,'  DO  YOU  WANT  TO  CHANGE  THE  HEADER  ?',/ 
,'  TYPE  "Y"  FOR  YES  .PUSH  RETURN  FOR  NO  .',/) 
ACCEPT  29, S 
FORMAT (Al) 

IF (S.EQ. ' Y 1 )GOTO  48 
GOTO  60 
CALL  SUBHDR 
TYPE  61 

FORMAT (/ , '  DO  YOU  WANT  TU  WRITE  THIS  FILE  ?',/ 

,'  TYPE  "Y"  FOR  YES  .PUSH  RETURN  FOR  NO  ',/) 

ACCEPT  29, S 

IF (S.EQ. ' Y ' )GOTO  46 

MT =1 

RETURN 

CALL  SUBWRI (UT , 1 ) 

MT=1 

RETURN 


icicicitititirir-k-k-kifie-k-k  if-k-kie-k-kir-k-kicitic-kic-kie-k-k-k-k-k-k-k-k-kic-k-kieicie-kleieic-kic-k'k'k'k-kieicic-k-kie-k-k-k-k-k 


c**************  THIS  SUBROUTINE  CALIBRATES  A  DATA  FILE  ************* 

Q *********************************************************************** 

c 

SUBROUTINE  CALBOF(UT.UB) 

VIRTUAL  UT ( 3604,2) ,UB( 3604,2) 

INTEGER  S 

COMPLEX  TT,B8,SS,TMB,SMB,RR 
BYTE  LINE1(60),LINE2(60),PARAM(60) 

BYTE  FNMT (31) , FNMB (31 ) ,FNMS(31 ) 

COMMON/FLG/FLAG 

COMMON/FILE/ ITS], KT.ISTYP.IFLG 
COMMON/LISFRQ/LOFQ, IUPFQ, INCRE 
COMMON/MHOR/L I NE 1 , L I NE  2 , PAR AM , HOR 
COMMON/ MWR I/FNMT ,FNMB ,FNMS 
COMMON/ SF I NO/STRG , KSTRG , KCHR 
DOUBLE  PRECISION  STR(25) 

LOGICAL  HDR 
C 

COMMON/ TARGET /RLT,CXT,RLCL8,CXCLB ,RDCLB 
COMMON/ BKDSP/RLB ,CXB ,RLS ,CXS,FCTR 
COMMON/CCXX/TT ,BB ,SS ,RR 
COMMON/ FLAGS/MT, MB, MS ,MN,MST,MSD 
COMMON/PAR/ASAF,ASAI ,ASAINC 
COMMON/MULTF/AE 
COMMON/KRSB/IJK 
C 

C  (*)  FIRST  STEP  IS  TO  OPEN  SHPHERE  FILE  . 

C 

002  FORMAT  (31A1) 

003  FORMAT  ('  ',60Al) 

004  FORMAT  (14) 

005  FORMAT  (15) 

010  FORMAT  ('  <><>  ENTER  SPHERE  FILE  NAME  :  ',$) 

050  FORMAT  ('  OPEN  ERROR  --  FILE  DOES  NOT  EXIST.') 

051  FORMAT  ('  DECODE  ERROR  —  LINE  COUNTER  “KT".') 

052  FORMAT  ('  — -  READ  ABORTED  — -') 

88  FORMAT  (12) 

C 

C 

IF (MSD.EQ.l)GOTO  102  iCHECK  IF  AUTOMATIC  DATA  READ  IS  SET. 
TYPE  010  ! GET  FILE  NAME 

ACCEPT  002.FNMS 
C 

102  IF  (FNMS(2).EQ.32)TYPE  052 
IF  (FNMS(2) ,EQ. 32) RETURN 
C 


OPEN  FILE 

OPEN  (UNIT=14,NAME=FNMS,TYP£=*0LD 1  ,FORM=* UNFORMATTED 1 , 
&  READONLY, ERR=1000) 

READ  HEADER 
READ  (14)  LINE1 
READ  (14)  LINE2 
READ  (14)  PARAM 
TYPE  003.LINE1 
TYPE  003, LINE 2 
TYPE  003, PARAM 
HDR=.TRUE . 

DECODE  HEADER 

IF  (PARAM(8).EO.'F')GOTO  995 
DECODE  (4,004,PARAM(4) ,ERR=1001)KT 
DECODE  (5,005,PARAM( 12) ,ERR=1001 )LOFQ 
DECODE  (5,005,PARAM(21 ) ,ERR=1001 ) INCRE 
DECODE  (2, 88, PARAM (31 ) , ERR =1008)  ISTYP 
GOTO  388 

DECODE  (4,2004,PARAM(4) ,£RR=1Q01)  KT 
FORMAT  (13) 

DECODE  (5, 005, PARAM (11) , ERR =1001)  LOFQ 
DECODE  (5, 005, PARAM (20) , ERR =1001 )  INCRE 
ISTYP=0 


SET  BAKAVE  FLAGS  AND  TYPES  [SCN  TYPE] 
IFLG=0 

IF  (M0D(ISTYP,10).NE.3)  GOTO  389 
IFLG=2 

CNE=INCRE/100.0 

IUPFQ=IFIX(L0FQ+(KT-1)*CNE) 

GOTO  91 

FMIN=LOFQ 
FMAX=IUPFQ 
TYPE  050 
RETURN 
TYPE  051 
RETURN 

TYPE  *, 'OLD  FILE  TYPE' 

I  ST YP= - 1 
GOTO  388 


C 


NOW  THE  SPHERE  FILE  HAS  BEEN  OPENED  ****************** 


91  FCTK=57 .2958 

C  THE  ABOVE  NUMBER  IS  A  CONVERSION  FACTOR  .DEGREES/RADIANS. 

C 

5S5  FORMAI (2X.7A1) 

23  FORMAT (Al) 

IF (MB .EQ. 1 )GOTO  26 
CALL  SU8REA(UB,2) 

IF ( I JK.EQ. 1)RETURN  [CHECKING  IF  BAKGND.  FILE  EXISTS. 

GOTO  25 

26  TYPE  bbb.FNMB 
TYPE  27 
ACCEPT  23, S 

IF (S.EQ. 1 Y ' )60T0  2b 
CALL  SU8REA(UB,2) 

IF( IJK.EQ. 1 )RETURN 

c********  NOW  TH£  desIREO  BACKGROUND  FILE  IS  READ  IN  ***************** 

C 

2b  CALL  SUBREA(UT.l) 

IF ( I JK.EQ. 1 ) RETURN 

C 

c******  Now  PROGRAM  MADE  SURE  THAT  THE  DESIRED  TARGET  FILE  IS  READ  IN  ** 

C 

27  FORMAT (/ , '  IS  A  BACKGROUND  FILE  ALREADY  IN  EXISTANCE. ' ,/ 

+  IF  YOU  WANT  THIS  FILE,  TYPE  "Y 

+  ,'  TO  CHANGE  THIS  FILE  .PUSH  RETURN  .'//,$) 

Q-k-k-k**  kit  *  -kit***  kkk  kkk  **  kick  it  **  *  *  kkkkkkkkkkk  ★★  ***  *  kkkkkkkkkkkkkkkkkkkk 


c 

IF (MSD.EQ. 1 )GOTO  37  [CHECKS  IF  AUTOMATIC  READ  FLAG  IS  SET. 

36  IF (MN.EQ.l)GOTO  30  [CHECKS  IF  AN  OLD  VALUE  EXACT  FILE 
C  EXISTS 

34  CALL  READNM 

GOTO  37 

30  TYPE  31 

31  FORMAT(/, '  A  VALUE  FOR  THE  MULTIPLYING  FACTOR  ALREADY  EXISTS',/) 
WRIT£( 7,32)AE 

32  FORMAT!/, 5X. '  MULTIPLYING  FACTOR  =  ' ,F8.2) 

TYPE  33 

33  FORMAT!/,'  IF  YOU  WANT  THIS  VALUE  .TYPE  "Y"  .',/ 

+  ,'  IF  YOU  WANT  TO  CHANGE  IT  .PUSH  RETURN  .',//,$) 

ACCEPT  23, S 
IF (S.EQ. ' Y ' )GOTO  37 
GOTO  34 
C 

C******  MOW  THE  PROGRAM  MADE  SURE  THAT  THE  DESIRED  VALUE  FOR  THE  **** 


C******  MULTIPLYING  FACTOR  IS  READ  IN 


**** 


O  o  o 
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ASAINC=INCR£/ 100.0  „„UT4r 

M=( ( IUPFQ-L0FQ)/ (ASAINC) )+l  1T0TAL  NUMBER  OF  POINTS. 

C 

c*************  NOW  PROGRAM  IS  READY  TO  PREFORM  CALIBRATION  ************ 


C 

00  19  1=1, M 
READ ( 14 )  US1.US2 
UT ( I , 1)=10.0**(UT ( I , l)/20.0) 

UB ( I,1)=10.0**(UB( 1,1)/ 20.0) 

US  1  =  10.0** (US  1/20.0) 

UT( I ,2)=(UT( I ,2) )/FCTR 
UB(  1 ,2)  =  (UB(  1 ,2)  )./FCTR 
US2=US2/FCTR 

RLT=(UT( I , 1) )*(COS(UT (1,2))) 

RLB  =  (UB( 1 , 1 ) )*(COS(UB( 1,2))) 

RLS=US1*(C0S(US2)) 

CXT=(UT(I,1))*(SIN(UT(I,2))) 

CXB=(UB ( I , 1 ) )*(SIN(UB( I , 2) ) ) 

CXS=US1*(SIN(US2) ) 

TT=CMPLX(RLT,CXT) 

BB=CMPLX(RLB,CXB) 

SS=CMPLX(RLS,CXS) 

TMB=TT-BB 
SMB=SS-BB 

ADJUSTING  DATA  WHEN  DIVISION  BY  ZERO  OCCURS  . 

IF (REAL(TMB) ) 440, 44 1,440 

441  TYPE*,'  TAR  =  BKGND  AT  DATA  POINT  #',I 
UT( I , 1 )=UT (1-1,1) 

UT ( I ,2)=UT (1-1,2) 

GOTO  19 

440  IF (REAL (SMB) ) 442, 443, 442 

443  TYPE*,'  SPHR  =  BKGND  AT  DATA  POINT  #',I 
UT ( I , 1 )=UT (1-1,1) 

UT ( I ,2)=UT ( 1-1,2) 

GOTO  19 

442  RR=TMB/SMB 
C 

RLCLB=REAL(RR) 

CXCLB=AIMAG(RR) 

RDCLB=(RLCLB**2.0)+(CXCLB**2.0) 

UT(I,1)=10.0*(AL0G10(R0CLB))+AE 
UT ( 1 ,2)=FCTR*(ATAN2(CXCL8 ,RLCLB) ) 

19  CONTINUE 

CLOSE  (UNIT=14,0ISP='SAVE ' ) 

C***************  NOW  ARRAY  UT  CONTAINS  THE  CALIBRATED  FILE  *********** 


c 

864  FORMAT ( 10A1 ) 

TYPE  864,'  ',1799 

MT-1 

MB=0 

MS=0 

TYPE  109 

109  FORMAT (/,'  DO  YOU  WANT  TO  CHANGE  THE  HEADER  ON  THE  ',/ 

+  CALIBRATED  FILE  ?  IF  YES  TYPE  "Y"  ,IF  NOT  PUSH  RETURN  .') 
ACCEPT  23, S 
IF (S.EQ. ' Y ' )GOTO  114 
GOTO  113 

114  CALL  EOTHDF 

113  TYPE  112 

112  FORMAT (//, '  DO  YOU  WANT  TO  WRITE  THE  CALIBRATED  FILE  ?',/ 

+  IF  YES  TYPE  "Y"  ,IF  NOT  PUSH  RETURN 
ACCEPT  23, S 
IF(S.EQ. ' Y  1  )GOTO  115 
GOTO  500 

115  CALL  SUBWRI (UT, 1) 

C 

500  RETURN 

END 


C****************  THIS  SUBROUTINE  PLOTS  A  DATA  FILE  ****************** 


SUBROUTINE  PLOTDF(UT.UB) 

BYTE  FNMT (31 ) ,FNMB(31) ,FNMS(31 ) 
VIRTUAL  UT (3604,2),UB(3604,2) 
REAL  VAL (3) 

INTEGER  R,FK 


COMMON/EEE/R.FK 
COMMON/FLAGS/MT ,M8 ,MS ,MN,MST 
COMMON/TOTNM/M , I ,  J ,MMM, I Y 
COMMON/DDD/ VAL, DELTA 
C  OMMON/MWR I / F  NMT , F  NMB , F  NMS 
COMMON/LISFRQ/LOFO, IUPFO, INCRE 
COMMON/ PVTPAR/AMN , AMX , PMN , PMX 
COMMON/ VARR/BGSTA , SMSTA .BGSTP , SMSTP 
COMMON/KRSB/IJK 

C 

100  TYPE  101 

101  FORMAT (/ , '  TARGET  FILE  :  TF  ',/ 

+  BACKGROUND  FILE  :  BF  ',/ 

+  SPHERE  FILE  :  SF  ',/ 

+  CALIBRATED  FILE  :  CF  ',/,) 

TYPE  102 

102  FORMAT (2X, 1  ENTER  TYPE  OF  FILE  :  ',$) 

ACCEPT  103, FK 

103  FORMAT (A2) 

IF (FK.EQ. *TF ' ) GOTO  11 
IF (FK.ELJ. ' BF  1  )GOTO  22 
IF (FK.EQ, 1 SF 1 )GOTO  22 
IF(FK.EQ.'CF')GOTO  11 
TYPE  104 

104  FORMAT (/ , 1  (*)  ERROR  IN  ENTERING  FILE  SPECIFICATION  .') 
GOTO  100 

Q  *********************** 

11  IF (MT ,EQ. 1 )GOTO  1030  ! CHECKING  IF  FILE  EXISTS 

GOTO  28 

1030  IF(IUPFQ.EO.O)GOTO  28  ‘CHECKING  IF  DATA  EXISTS 

WRITE(7,707)FNMT 

707  FORMAT(/,'  FILE  NAME  : ' , IX, 31A1 ) 

TYPE  15 

15  FORMAT (/ , *  THE  ABOVE  IS  A  DATA  FILE  IN  EXISTANCE. ' ,/ 

+  ,'  IF  YOU  WANT  TO  PLOT  THAT  FILE  .THEN  TYPE  "Y"  .',/ 

+  '  IF  YOU  WANT  TO  PLOT  ANOTHER  ONE  .TYPE  ANY  OTHER  ',/ 

+  ,'  LETTER  .',//,$) 


ACCEPT  18, R 

18  FORMAT (A1 ) 

IF(R.EQ.'Y')GOTO  19 

C  THE  USER  STILL  HAS  THE  OPTION  OF  PLOTTING  ANOTHER  TARGET  FILE 
C  DEPENOING  ON  THE  VALUE  OF  R  . 

CALL  SU8REA(UT, 1) 

IF ( IJK.EQ. 1 )GOTO  28  [CHECK  AGAIN  IF  FILE  EXISTS. 

19  DELTA=INCRE/ 100.0 
M=((IUPFQ-LOFQ)/ (DELTA) )+l 
CALL  MINMAX(UT) 

I  Y  =  1 

C  I  Y  =  1  =>  PLOT  A  TARGET  FILE  . 

GOTO  363 

Q'-k-k-k-k-k-kic-k-kic-k-k-k'k-k'k'k'klcic'k-kic'k 

C  CHEKING  IF  THERE  ACTUALY  IS  A  OATA  FILE  IN  VIRTUAL  MEMORY  . 

C 

22  IF( (MB.EQ. 1 ) .OR. ( IUPFQ.NE .0) )GOTO  14  [CHECK  IF  SPHERE  FILE 

C  EXISTS. 

IF( (MS. EQ.l). OR. ( IUPFQ.NE. 0))G0T0  140  [CHECK  IF  BA KG NO.  FILE 
C  EXISTS. 

GOTO  28 

14  WR ITE ( 7 , 70/ )FNMB 

TYPE  16 
ACCEPT  18, R 
IF(R.EQ.'Y')GOTO  33 
CALL  SUBREA(UB,2) 

IF( IJK.EO.l )GOTO  28  [CHECK  IF  DATA  FILE  EXIST 

GOTO  33 

140  WRITE( 7,777)FNMS 

777  FORMAT (/ , 1  FILE  NAME  :  ',31A1) 

TYPE  15 
C 

C  THE  USER  STILL  HAS  A  CHANCE  TO  PLOT  ANOTHER  SPHERE  OR  BACKGROUND 
C  FILE. 

C 

ACCEPT  18, R 
I F ( R .EQ . ' Y * )GOTO  33 
CALL  SUBREA(UB,3) 

IF ( IJK.EQ. 1 )GOTU  28 

33  DELTA=INCRE/100.0  [ACTUAL  INCREMENT  IN  ASPECT  ANGLE. 

M=((IUPF0-LOF0)/ (DELTA) )+l  [TOTAL  NUMBER  OF  POINTS. 

CALL  MINMAX(UB) 

I  Y=2 
C 

C  IY=2  =>  PLOT  A  SPHERE  OR  BACKGROUND  FILE  . 

C 

363  IF(MST ,EQ. 1 )GOTO  125  [CHECKING  IF  A  SCALE  HAS  BEEN  SET. 

TYPE  364 
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364  FORMAT (/,'  DO  YOU  DESIRE  TO  SET  YOUR  OWN  SCALE  ?',/ 


+  IF  YES  .TYPE  "Y".  IF  NO  TYPE  ANY  OTHER  LETTER 
ACCEPT  18, R 
IF(R.EO.'Y')GOTO  366 
GOTO  170 

366  CALL  SETSCL 

GOTO  625 
C 

c************  SETTING  AN  ARBITRARY  SCALE  *********** 

170  IF (BGSTA.LT.O)GOTO  171 

AMX=10.0*( I  NT (BGSTA/10.0) )+10.0 
GOTO  172 

171  AMX=10.0*( INT (BGSTA/10.0) ) 

172  IF(SMSTA.LT.O)GOTO  173 

AMN=10.0*( INT (SMSTA/10.0) ) 

GOTO  174 

173  AMN=10.0*( I  NT (SMSTA/10.0) )-10.0 

174  IF (BGSTP.LT. 0)G0T0  175 
PMX=10.0*( INT(BGSTP/10.0) )+10.Q 
GOTO  176 

175  PMX=10.0*( INT(BGSTP/10.0) ) 

176  IF ( SMSTP.LT. 0) GOTO  177 
PMN=10.0*( INT(SMSTP/10.0) ) 

GOTO  125 

177  PMN=10.0*( INT(SMSTP/10.0) )-10,0 
C 

C 

125  TYPE  105 

105  FORMAT (/,'  *  THE  PRESENT  SCALE  IS  *') 
WRITE(7,710)AMX 

710  FORMAT (/ , ‘  MAXIMUM  AMPLITUDE  =  * ,F8.2) 

WRITE( 7,711)AMN 

711  FORMAT ( *  MINIMUM  AMPLITUDE  =  *,F8.2) 

WRITE(7,712)PMX 

712  FORMAT ( 1  MAXIMUM  PHASE  =  *,F8.2) 

WRITE( 7,713)PMN 

713  FORMAT ( '  MINIMUM  PHASE  =  ’.F8.2) 

C 

C 

TYPE*,'  ' 

TYPE*, '  IF  YOU  WANT  THE  ABOVE  SCALE  PUSH  RETURN  .' 
TYPE*,'  IF  YOU  WANT  TO  CHANGE  THE  SCALE  TYPE  "C"  .' 
TYPE*,'  IF  YOU  WANT  THE  M0DUL0-10  SCALE  TYPE  "T" 
ACCEPT  18, R 

IF(R.EQ. *C' )CALL  SETSCL 
IF (R ,EQ. 1 T  * )GOTO  170 
C 


C  .  SETTING  OF  HORIZONTAL  SCALE  . 

C 

1006  F0RMAT(F8.2) 

626  TYPE  1001 

1001  FORMAT (  / , 1  ENTER  INITIAL  VALUE  OF  ASPECT  ANGLE  :  ',$) 

AffFPT*  XI 

IF (Xl.LT.LOFO)GOTO  1003 
GOTO  1004 

1003  TYPE*,'  INITIAL  VALUE  OF  ASPECT  ANGLE  IS  SMALL 

GOTO  626 
10U4  TYPE  1002 

1002  FORMAT (/ , 1  ENTER  FINAL  VALUE  OF  ASPECT  ANGLE  :  ',$) 

ACCEPT*, X2 

N1=((X1-L0FQ)/0ELTA)+1 
N2=( ( X2-L0FQ)/ DELTA )+l 
C . 

c 

IF ( 1 Y-l ) 126, 126,111 
126  CALL  CLRCRT 

CALL  ORBUFR ( 0) 

CALL  FRAME 

CALL  NUMBER ( XI, X2) 

CALL  PLACEP(VAL.O) 

C 

C  THIS  00  LOOP  COMPUTES  THE  LOCATION  OF  THE  OOT  ON  THE  SCREEN  . 

C  ITTINR()  IS  A  PUP-11  SOFTWARE  PACKAGE  ,IT  ALLOWS  THE  USER  IN  THIS 

C  CASE  TO  INTRRUPT  THE  PLOTTING  PROCEDURE  UPON  PRESSING  CARRIGE 
C  RETURN. 

C  AND  ALSO  GOING  BACK  TO  COMMAND  MODE  WHEN  <CR>  IS  FOLLOWED  BY  "0"  . 

C 

110  DO  20  I=N1 ,N2 

IF(UT(l,l).GT.AMX)  VAL(1)=AMX 
IF (UT ( I , 1 ) ,GT.AMX)GOTO  2050 
IF(UT(I,1).LT.AMN)  VAL(1)=AMN 
I F ( UT (1,1) ,LT.AMN)GOTO  2050 
VAL(1)=UT(I,1) 

2050  IF ( UT (1,2) .GT.PMX)  VAL(2)=PMX 

IF(UT( I ,2) .GT.PMX)GOTO  2060 
IF(UT (1,2) .LT.PMN)  VAL(2)=PMN 
IF (UT( I , 2) .LT.PMN)G0T0  2060 
VAL(2)«UT(I,2) 

2060  VAL(3)=Xl+( ( I-Nl )*DELTA) 

CALL  PLACEP{VAL,1) 

ICH= ITT INR ( ) 

IF ( ICH.LT.O)GOTO  20 
ACCEPT  18, R 
IF (R ,EQ. 'Q 1 )G0 TO  507 
GOTO  20 
50/  MMM=I 

I=N2 

20  CONTINUE 


Y ■.  '"'S .  i’ ,  '(ViV'".  ■' 
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GOTO  90 

Q ************* *************************** 

111  CALL  CLRCRT 

CALL  0R8UFR(0) 

CALL  FRAME 

CALL  NUMBER ( XI, X2) 

CALL  PLACEP(VAL.O) 

C 

DO  ?7  I=N1 ,N2 

IF (UB( I ,1) .GT.AMX)  VAL(1)=AMX 
IF(UB(I,1).GT.AMX)G0T0  1007 
IF (UB( 1,1)  .LT.AMN)  VAL(1)=AMN 
IF(UB(I,1).LT.AMN)G0T0  1007 
VAL ( 1  )=UB( 1,1) 

1007  IF (UB ( I ,2) .GT.PMX)  VAL(2)=PMX 

I F ( UB (1,2) .GT.PMX)G0T0  1008 
I F ( UB (1,2) .LT.PMN)  VAL(2)=PMN 
IF(UB(I,2).LT.PMN) GOT  0  1008 
VAL(2)=UB(I ,2) 

1008  VAL(3)=Xl+( ( I-Nl )*DELTA) 

CALL  PLACEP(VAL.l) 

ICH=ITTINR( ) 

IF ( ICH.LT.O)GOTO  27 
ACCEPT  18, R 
IF(R.E0.'g')GOTO  510 
GOTO  27 
510  MMM=I 

I=N2 

27  CONTINUE 
GOTO  90 

Q ******** ★*****★★ ★***★****★***★*★★ **★**★★***★ 

c 

28  TYPE  29 

29  FORMAT (/ , 1  YOU  HAVE  NOT  READ  IN  A  FILE  TO  PLOT 

+  ,'  SO  .CANNOT  EXECUTE  PLOT  SUBROUTINE  .',//,$) 

90  RETURN 


Q  ★★★**★*★******★★**★★****★★*★★★**★*★*★**★★  ***★★★★★*★★★★***★★**★****■★***■* 


c*************  THIS  SUBROUTINE  CLEARS  THE  "CRT"  SCREEN  *****  ********* 

r *****★*****★*★*★★*********★***★*★*★★★★★★**★****★★***★★*★★**★**★★*★★★*** 


CALL  CLRCRT 

RETURN 

END 


£★* ****** ******************* *********************************** ********* 


C*********  yHIS  SUBROUTINE  COMPUTES  MAXIMUM  &  MINIMUM  VALUES  ******* 
C*********  OF  THE  AMPLITUDE  AND  PHASE  IN  A  DATA  FILE  .  ******* 

Q *********************************************************************** 

c 

SUBROUTINE  MI NMAX(ARRAV) 

VIRTUAL  ARRAY (3604,2) 

REAL  UX(2),UM(2) 

COMMON/ FILE/ ITS  1 ,KT 
COMMON/ VARR/BGSTA, SMSTA, BGSTP, SMSTP 
C 

C  THE  VARAIBLES  : 

C  BGSTA  =  MAXIMUM  AMPLITUDE  . 

C  SMSTA  =  MINIMUM  AMPLITUDE  . 

C  BGSTP  =  MAXIMUM  PHASE  . 

C  SMSTP  =  MINIMUM  PHASE  . 

C  SET  INITIAL  VALUES  . 


BGSTA=-99999.0 

BGSTP=-99999.0 

SMSTA=999999.0 

SMSTP=999999.0 

DO  30  1=1, KT 

BGSTA=AMAX1 ( BGSTA, ARRAY (1,1)) 
8GSTP=AMAX1 (BGSTP .ARRAY (1,2)) 
SMSTA=AM I N 1 ( SMSTA .ARRAY (1,1)) 


30 

r 

SMSTP=AM INI (SMSTP, ARRAY ( 1 ,2 j  j 

BP 

WRITE(7,734)BGSTA 

L^v  V- 

734 

FORMAT (/ , 1  MAXIMUM  AMPLITUDE 

=  1  »F7.2) 

Cs'v  • 

WRITE( 7 ,735)SMSTA 

735 

FORMAT ( 1  MINIMUM  AMPLITUDE  = 

•,F7.2) 

WRITE ( 7 , 736)BGSTP 

■a 

736 

FORMAT (•  MAXIMUN  PHASE 

1  »F7.2) 

t*.  . 

WR I TE ( 7 , /37 )SMSTP 

|“v.v 

737 

FORMAT C  MINIMUM  PHASE 

1  »F7,2) 

RETURN 

END 


"  .  *  >  V.  V. 
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0****** ****** *********************************************************** 
C************  THIS  SUBROUTINE  SETS  THE  PLOTTING  SCALES  *************** 
0 *********************************************************************** 

C 

SUBROUTINE  SETSCL 
C 

INTEGER  R 

COMMON/ FLAGS/MT, MB, MS, MN.MST 
COMMON/ PVT PAR /AMN,AMX,PMN,PMX 
COMMON/ANSWER/R 
C 

17b  FORMAT (/ , 1  (*)  ILLEGAL  FORMAT  .TRY  AGAIN  .(*)',) 

12  FORMAT (A1 ) 

55  FORMAT (F7.0) 

66  TYPE  10 

10  FORMAT (  / , '  ENTER  THE  MAXIMUM  AMPLITUDE  ',/ 

+  ,'  AMX  =  ',$) 

READ (5, 55, ERR =200) AM X 

19  TYPE  20 

20  FORMAT(/,'  ENTER  THE  MINIMUM  AMPLITUDE  ',/ 

+  ,'  AMN  =  ',$) 

READ(5,55,ERR=210)AMN 

29  TYPE  30 

30  FORMAT!/,'  ENTER  THE  MAXIMUM  PHASE  ANGLE  ',/ 

+  ,'  PMX  =  ',$) 

READ(5,55,ERR=220)PMX 

39  TYPE  40 

40  FORMAT!/,'  ENTER  THE  MINIMUM  PHASE  ANGLE  *,/ 

+  ,'  PMN  =  ',$) 

READ( 5,55,ERR=230)PMN 
C 

50  FORMAT!/,'  HAVE  YOU  MADE  A  TYPING  ERROR  ?',/ 

+  ,'  IF  YES  TYPE  "C"  , IF  NOT  PUSH  RETURN  .',/) 

C 

GOTO  123 
200  TYPE  175 

GOTO  66 
210  TYPE  175 

GOTO  19 

220  TYPE  175 

GOTO  29 

230  TYPE  175 

GOTO  39 
C 

123  TYPE  80 

80  FORMAT!/,'  MAXIMUM  AMP.  =  ',$) 

WRITE! 7,55)AMX 
TYPE  82 

FORMAT!,'  MINIMUM  AMP.  =  ',$) 

WRITE( 7,55)AMN 
TYPE  84 


82 


84 


FORMAT ( , '  MAXIMUM  PHS.  =  \$) 
WRITE( 7,55)PMX 
TYPE  86 

86  FORMAT ( *  MINIMUM  PHS.  =  ',$) 
WR I TE ( 7,S5)PMN 
C 

TYPE  bO 

ACCEPT  12, R 

IF (R .EQ. ' C 1 )OOTO  66 

MST  =  1 

RETURN 

END 
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/  / 


C*********  THIS  SUBROUTINE  SETS  THE  DATA  FILE  NAMES  INVOLVED  IN  THE  ** 
c*********  CALIBRATION  PROCEDURE  IN  A  BUFFER  .  ** 

£*★*  ***************************************  *******^******7lr**********:*r** 

c 

SUBROUTINE  SETUTA 

BYTE  FNMT ( 31 ) ,FNM8{ 31 ) ,FNMS{ 31 ) 

COMMON/MWRI/FNMT ,FNMB ,FNMS 
COMMON/MULTF/AE 

COMMON/FLAGS/MT ,MB ,MS ,MN,MST ,MSD 

C 

45  FORMAT ( 31A1 ) 

TYPE  10 

10  FORMAT ( / , ‘  TARGET  FILE  NAME  :  (1)',/ 

+  , '  BACKGROUND  FILE  NAME  :  (2)  ',/ 

+  ,'  SPHERE  FILE  NAME  :  (3)  ',/ 

+  EXACT  FILE  VALUE  :  (4)  ',/ 

+  TO  LIST  FILE  NAMES  :  (5)  ',/ 

+  TO  EXIT  ,PuSH  RETURN  .') 

TYPE  15 

15  FORMAT (/ , '  TYPE  THE  NUMBER  IN  (  )  TO  CHOOSE  OPTION  .') 

77  TYPE  46 

46  FORMAT (/ , '  OPTION  ?',$) 

ACCEPT  13,1 

13  FORMAT (II) 

I F ( I .EQ.l )GOTO  11 
IF ( 1 ,EQ.2)G0T0  22 
IF ( I .EQ.3)G0T0  33 
IF ( I ,EQ.4)G0T0  44 
IF ( I ,EQ.5)G0T0  55 
I F ( I ,EQ.O)GOTO  190 
GOTO  77 

11  TYPE  12 

12  FORMAT (/ , 1  (*)  ENTER  TARGET  FILE  NAME  :  ' ,$) 

ACCEPT  45, FNMT 

MSD:-1 
GOTO  77 

22  TYPE  23 

23  FORMAT (/ , 1  (*)  ENTER  BACKGROUND  FILE  NAME  :  ',$) 

ACCEPT  45.FNMB 

MSD  =  1 
GOTO  11 

33  TYPE  34 

34  FORMAT (/, '  (*)  ENTER  SPHERE  FILE  NAME  :  ',;) 

ACCEPT  45,FNMS 

MSD  =  1 
GOTO  11 


/. 
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C***********  TH|S  SUBROUTINE  SETS  THE  FLAGS  FUR  THE  PROGRAM 


SUBROUTINE  SETFLG 

COMMON/FLAGS/MT ,H8,HS,MN,MST ,MSO 
COMMON/ ARBFG/ IF 

FORMAT!/, '  (*)  ILLEGAL  FORMAT  ,TRY  AGAIN  .(*)*,) 
FORMAT (It) 

MR  I TE ( 7 , 245 )MT ,MB .MS .MN ,MST .MSO 
1)0  29  1-1.6 
TYPE  10,1 

FORMAT!/, '  ENTER  FLAG  #(\Il,‘)  -  \S) 

REA0(5,2S,ERR-29B) IF 

GOTO( 11, 22. 33,44,55,66)1 

MT-IF 

GOTO  29 

MB-IF 

GOTO  29 

MS- IF 

GOTO  29 

MN-IF 

GOTO  29 

MST-IF 

GOTO  29 

MS0-1F 

GOTO  29 

CONTINUE 

MR  1 TE ( 7 , 246 )NT ,MB ,MS ,MN ,MST ,MSO 
FORMAT!/, '  FLAGS  •  ',6(11),/) 

RETURN 
TYPE  303 
RETURN 
ENO 


5R SSwRRwSs 


nono 


THIS  SUW0UT1*  E1IT$  FROM  WIN  PROGRAM  CdNPUHlY.  ******** 


SUBROUTINE  Ell Y 

type  m 

220  FORMAT (//, 101, *  *•*•••••*•*•**•••••••*•••••••*••••••*•*•*•••*,// 

♦  ,101.*  ••*•••••••  asuprm  is  terminated  ••*•*••*•*,// 

♦  .101.'  •**••••••••••••••*•••*•**•••••*••*••*•***•*• • , | 


awnfVft 


(I)  D.l.  J.5.  *O01,  l.«.  «. 

sihKt«rf  itfi*,  tsi  rKMtHi  Inin  Jmrr  ttti. 

f?)  J.t.  C***.  (.».  MiMft*.  *!*•  <M«  U4f#  KHiWitf  «lt  ft«#  «*«• 
ft  I#  Virwturt*.  (IfCtffkiptf  Uintffr 
f|«|«M,  Ott**#*  t«V. 


(I)  (.*.  Mill**  «M  J.0,  *ow»f.  *H»Jlt«i  fllli  »»«»nU^ytct 


l«Mr  (W  Vk(I«*  mm»>»<w»*i  t»y> 
4.  «M  Mtf  l«M. 
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